 ; ACSPNT.m --> PROCESS RECEIVED HL7 MESSAGE (ADT-A31) FROM ACS COMPUMD.
 ;
 ;
 ; DBS CALLS:
 ; D FILE^DIE   REPLACES EXISTING RECORDS
 ; D UPDATE^DIE ADDS NEW RECORDS
 ;
 ; GLOBAL/LOCAL VARIABLES:
 ; PIDSEG       CURRENT MESSAGE PID SEGMENT
 ; PIDSEGNAME   TEMP STORAGE OF PATIENT NAME FOR FORMATTING
 ; INSSEG       ARRAY OF CURRENT MESSAGE IN1 SEGMENTS
 ; PNTROOT      FDA_ROOT FOR PATIENT DBS CALLS
 ; VALPNTROOT   VALIDATED PNTROOT
 ; PNTINSROOT   FDA_ROOT FOR PATIENT INSURANCE
 ; PNTERR       ERR MESSAGES FROM PATIENT DBS CALL
 ; VALERR       ERR MESSAGES FROM VALIDATION CALL
 ; INSCOUNT     COUNTER FOR INSURANCE ARRAY
 ; FDAIEN       INTERNAL ENTRY NUMBER DERRIVED FROM PATIENT NUMBER
 ; FINDERR      ERR MESSAGES FROM FIND^DIC CALL
 ; SEG          TEMP STORAGE FOR EACH MESSAGE SEGMENT
 ; HLMSG        MESSAGE CONTROL FOR $$STARTMSG^HLPRS
 ; HLMTIENS     CURENT MESSAGE RECEIVED
 ; HEADER       CURRENT MESSAGE HEADER
 ; RESULT       RETURNED ARRAY FROM FIND^DIC
 ; SSNRESULT    RESULT OF SOCIAL SECURITY SEARCH
 ; SSNFINDERR   ERR MESSAGES FROM SOCIAL SECURITY SEARCH
 ; SSNFOUND     FLAG SET IF SOCIAL SECURITY NUMBER FOUND IN DATABASE
 ; VALFLAG      SET IF VAL FAILS
 ; ^ACSERR      LOGFILE FOR VALIDATION ERRORS
 ; ERRDATE      DATE FOR ERR MESSAGE LOG
 ; ^CHECK       TEMP STORAGE FOR ERROR MESSAGES
 ;
 ; COMMENTS:
 ; ;)           TEMPORARY COMMENT/LINE OF CODE
 ;
 ; FILEMAN FILES:
 ; ^DPT         PATIENT     (#2)
 ;
 ; last update 5.31.2007 0825
 ;
EN  ;entry point, init
 N ERRDATE
 N FDAIEN
 N HLMSG,HEADER,SEG
 N PIDSEG,PNTROOT,PNTERR,PIDSEGNAME
 N INSCOUNT,INSSEG
 N RESULT,FINDERR
 N SSNRESULT,SSNFINDERR,SSNFOUND
 N VALPNTROOT,VALFLAG,VALERR
 K ^CHECK
 S VALFLAG=0
 S ^CHECK("0BEGIN")="VERSION 3.9 - START" ;)
 S SSNFOUND=0 ;set ssn found flag to false
 S DUZ=1,DUZ(0)="@" ;initialize user number and give programmer access to files
 ;set current d/t
 N TEMPDATE
 D DT^DILF("ERSX","NOW",.TEMPDATE)
 S ERRDATE=TEMPDATE(0)
 K TEMPDATE
GETHEADER   ;
 ;
 ;get received message header using HLMTIENS(last message received)
 I $$STARTMSG^HLPRS(.HLMSG,HLMTIENS,.HEADER) G GETSEGMENT
 ;
 ;Fall through if message not found
 S ^ACSERR(ERRDATE,"ACSPNT","ERR")="** Message Not Found (IEN "_HLMTIENS_") **"
 G REXIT ;clean-up and quit this routine
GETSEGMENT  ;
 ;loop through segments
 S ^CHECK("0HLMTIENS")=HLMTIENS ;)
 S INSCOUNT=0;
 F  Q:'$$NEXTSEG^HLPRS(.HLMSG,.SEG)  D
 . I SEG("SEGMENT TYPE")="PID" ;save PID segment
 . I  S PIDSEG("NO")=$$GET^HLOPRS(.SEG,3)
 . I  S PIDSEG("LNAME")=$$GET^HLOPRS(.SEG,5)
 . I  S PIDSEG("FNAME")=$$GET^HLOPRS(.SEG,5,2)
 . I  S PIDSEG("MI")=$$GET^HLOPRS(.SEG,5,3)
 . I  S PIDSEG("REM")=$$GET^HLOPRS(.SEG,6)
 . I  S PIDSEG("DOB")=$$GET^HLOPRS(.SEG,7)
 . I  S PIDSEG("SEX")=$$GET^HLOPRS(.SEG,8)
 . I  S PIDSEG("ADDR1")=$$GET^HLOPRS(.SEG,11)
 . I  S PIDSEG("ADDR2")=$$GET^HLOPRS(.SEG,11,2)
 . I  S PIDSEG("CITY")=$$GET^HLOPRS(.SEG,11,3)
 . I  S PIDSEG("STATE")=$$GET^HLOPRS(.SEG,11,4)
 . I  S PIDSEG("ZIP")=$$GET^HLOPRS(.SEG,11,5)
 . I  S PIDSEG("HPHONE")=$$GET^HLOPRS(.SEG,13)
 . I  S PIDSEG("EMAIL")=$$GET^HLOPRS(.SEG,13,4)
 . I  S PIDSEG("WPHONE")=$$GET^HLOPRS(.SEG,14)
 . I  S PIDSEG("SSN")=$$GET^HLOPRS(.SEG,19)
 . I SEG("SEGMENT TYPE")="IN1" ;save INS segments
 . I  ;S INSSEG(INSCOUNT,"PLAN")=$$GET^HLOPRS(.SEG,2)
 . I  S INSSEG(INSCOUNT,"INS")=$$GET^HLOPRS(.SEG,3)
 . I  S INSSEG(INSCOUNT,"NAME")=$$GET^HLOPRS(.SEG,4)
 . I  S INSSEG(INSCOUNT,"ADDR1")=$$GET^HLOPRS(.SEG,5)
 . I  S INSSEG(INSCOUNT,"ADDR2")=$$GET^HLOPRS(.SEG,5,2)
 . I  S INSSEG(INSCOUNT,"CITY")=$$GET^HLOPRS(.SEG,5,3)
 . I  S INSSEG(INSCOUNT,"STATE")=$$GET^HLOPRS(.SEG,5,4)
 . I  S INSSEG(INSCOUNT,"ZIP")=$$GET^HLOPRS(.SEG,5,5)
 . I  S INSSEG(INSCOUNT,"PHONE")=$$GET^HLOPRS(.SEG,7)
 . I  ;S INSSEG(INSCOUNT,"GRP")=$$GET^HLOPRS(.SEG,8)
 . I  S INSSEG(INSCOUNT,"NOIL")=$$GET^HLOPRS(.SEG,16)
 . I  S INSSEG(INSCOUNT,"NOIF")=$$GET^HLOPRS(.SEG,16,2)
 . I  S INSSEG(INSCOUNT,"NOIM")=$$GET^HLOPRS(.SEG,16,3)
 . I  S INSSEG(INSCOUNT,"REL")=$$GET^HLOPRS(.SEG,17)
 . I  S INSSEG(INSCOUNT,"POL")=$$GET^HLOPRS(.SEG,36)
 . I  S INSCOUNT=INSCOUNT+1
 S INSCOUNT=INSCOUNT-1
 ;all validation performed on cobol side with exception of SSN.
 ;convert DOB from yyyymmdd to mmddyyyy
 S PIDSEG("DOB")=$E(PIDSEG("DOB"),5,8)_$E(PIDSEG("DOB"),1,4)
 ;set PIDSEGNAME format
 S PIDSEGNAME=$G(PIDSEG("LNAME"))_","_$G(PIDSEG("FNAME"))
 I $G(PIDSEG("MI"))'="" S PIDSEGNAME=PIDSEGNAME_" "_PIDSEG("MI") ;if midinit exists, append to name
 ;set INSSEGNOI format and convert relationship code
 N COUNT,TEMP
 S COUNT=0
 S TEMP=""
 F  Q:COUNT>INSCOUNT  D
 . S INSSEG(COUNT,"NOI")=$G(INSSEG(COUNT,"NOIL"))_","_$G(INSSEG(COUNT,"NOIF"))
 . I $G(INSSEG(COUNT,"NOIM"))'="" S INSSEG(COUNT,"NOI")=INSSEG(COUNT,"NOI")_" "_INSSEG(COUNT,"NOIM")
 . I INSSEG(COUNT,"REL")="0" S TEMP="PATIENT"
 . I INSSEG(COUNT,"REL")="1" S TEMP="SPOUSE"
 . I INSSEG(COUNT,"REL")="2" S TEMP="NATURAL CHILD"
 . I TEMP="" S TEMP="DO NOT USE"
 . S INSSEG(COUNT,"REL")=TEMP
 . S TEMP=""
 . S COUNT=COUNT+1
 K COUNT,TEMP
 M ^CHECK("1PATIENTINFO")=PIDSEG ;)
 M ^CHECK("1INSURANCE")=INSSEG ;)
 D EN^ACSPNT2 ;do insurance company processing
 I VALFLAG G REXIT ;if validation fails in ACSPNT2, quit
 ;
 ;
PROCESSPATIENT  ;
 ;)FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
 ;)finds ACS patient number in ^DPT : Patient File (#2)
 ;)RETURNED VALUES
 ;) List ^FOUND
 ;) ^FOUND("DILIST",0)="1^*^0^"  <--1ST NUMBER IS HOW MANY FOUND (0 OR 1)
 ;) ^FOUND("DILIST",2,1)=1       <--IEN
 ;)USE THIS TO ADD NEW PATIENT WITH ACSPATNO (CROSS REF IEN)
 ;)S ^DPT("ACSPATNO",(patient number from acs),1)="" <--1 EQUALS IEN
 ;
 I PIDSEG("SSN")'?9N S PIDSEG("SSN")="" ;if ssn is != to pattern (9 numbers), set to ""
 E  D FIND^DIC(2,,"@","X",PIDSEG("SSN"),,"SSN",,,"SSNRESULT","SSNFINDERR")
 M ^CHECK("2SSNRESULT")=SSNRESULT ;)
 M ^CHECK("2SSNFINDERR")=SSNFINDERR ;)
 I PIDSEG("SSN")="" S PIDSEG("SSN")="@" G CHECKACSPATNO ;if ssn blank, set to "@"
 I $P(SSNRESULT("DILIST",0),"^",1)'=0 S SSNFOUND=1 ;if found ssn, set ssn found flag to true
 S ^CHECK("2SSNFLAG")=SSNFOUND ;)
CHECKACSPATNO   ;
 M ^CHECK("3PROCESSEDSSN")=PIDSEG("SSN") ;)
 D FIND^DIC(2,,"@","X",PIDSEG("NO"),,"ACSPATNO",,,"RESULT","FINDERR")
 M ^CHECK("4FINDERR")=FINDERR ;)
 M ^CHECK("4FINDRESULT")=RESULT ;)
 I $P(RESULT("DILIST",0),"^",1)=0 G DOUPDATEDIE ;if no entries for ACSPATNO found, go to update (add)
 ;fall through for found entry
 ;
 ;
DOFILEDIE   ;
 ;set fields using $GET ($G) to avoid 'variable undefined' error
 N TEMPIEN
 S TEMPIEN=RESULT("DILIST",2,1)
 S FDAIEN=RESULT("DILIST",2,1)_"," ;set IEN from returned array plus comma
SSNSET ;
 I SSNFOUND S PIDSEG("SSN")="@" ;if ssn exists in database, set ssn to @ to avoid duplicate ssn error on add new entry
 E  S PNTROOT(2,FDAIEN,.363)=PIDSEG("SSN")
 E  S PNTROOT(2,FDAIEN,.364)=$E(PIDSEG("SSN"),6,9)
 E  S PNTROOT(2,FDAIEN,.09)=PIDSEG("SSN")
 I PIDSEG("SSN")="@" S PNTROOT(2,FDAIEN,.363)="--"
 I  S PNTROOT(2,FDAIEN,.364)=""
 K TEMPIEN
 S ^CHECK("5FILEIEN")=FDAIEN ;)
 S PNTROOT(2,FDAIEN,.01)=PIDSEGNAME
 S PNTROOT(2,FDAIEN,.091)=$G(PIDSEG("REM"))
 S PNTROOT(2,FDAIEN,.03)=$G(PIDSEG("DOB"))
 S PNTROOT(2,FDAIEN,.02)=$G(PIDSEG("SEX"))
 S PNTROOT(2,FDAIEN,.301)="NO"
 S PNTROOT(2,FDAIEN,391)="NON-VETERAN (OTHER)"
 S PNTROOT(2,FDAIEN,1901)="NO"
 S PNTROOT(2,FDAIEN,.111)=$G(PIDSEG("ADDR1"))
 S PNTROOT(2,FDAIEN,.112)=$G(PIDSEG("ADDR2"))
 S PNTROOT(2,FDAIEN,.114)=$G(PIDSEG("CITY"))
 S PNTROOT(2,FDAIEN,.115)=$G(PIDSEG("STATE"))
 S PNTROOT(2,FDAIEN,.116)=$G(PIDSEG("ZIP"))
 S PNTROOT(2,FDAIEN,.131)=$G(PIDSEG("HPHONE"))
 S PNTROOT(2,FDAIEN,.132)=$G(PIDSEG("WPHONE"))
 S PNTROOT(2,FDAIEN,.133)=$G(PIDSEG("EMAIL"))
 S FDAIEN=RESULT("DILIST",2,1) ;set IEN from returned array minus comma
 S ^CHECK("5FILEIEN2")=FDAIEN ;)
 ;do validation
 D VALS^DIE("","PNTROOT","VALPNTROOT","VALERR")
 N INDEX,ERRNUM,ERRCOUNT
 S INDEX=""
 S ERRCOUNT=1
 F  S INDEX=$O(VALPNTROOT(2,FDAIEN_",",INDEX)) Q:INDEX=""  D
 . I VALPNTROOT(2,FDAIEN_",",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
 . I  S ^ACSERR(ERRDATE,"ACSPNT","FILE ERRNUM")=ERRNUM
 . I  D LOGERR
 . I  Q
 K INDEX,ERRNUM,ERRCOUNT
 ;
 ;begin file locks
FILELOCKDPT ;
 L +^DPT(FDAIEN):1 ;try lock
 I $T G DOFILEDIEFILER ;if lock, continue
 E  G FILELOCKDPT ;if lock fails, keep trying
 ;end locks
 ;
DOFILEDIEFILER  ;
 D FILE^DIE("S","VALPNTROOT","PNTERR")
 M ^CHECK("5FILE")=PNTERR ;)
 ;delete previously saved insurances
 N COUNT,DELROOT,DELIEN
 S COUNT=1
 F  Q:COUNT>5  D
 . S DELIEN=COUNT_","_FDAIEN_","
 . S DELROOT(2.312,DELIEN,.01)="@"
 . D FILE^DIE("E","DELROOT")
 . S COUNT=COUNT+1
 K COUNT,DELROOT,DELIEN
 ;add current insurances from message
 N COUNT,ADDROOT,ADDIEN
 S COUNT=0
 F  Q:COUNT>INSCOUNT  D
 . S ADDIEN="?+1,"_FDAIEN_","
 . S ADDROOT(2.312,ADDIEN,.01)=INSSEG(COUNT,"NAME")
 . S ADDROOT(2.312,ADDIEN,17)=INSSEG(COUNT,"NOI")
 . S ADDROOT(2.312,ADDIEN,16)=INSSEG(COUNT,"REL")
 . S ADDROOT(2.312,ADDIEN,1)=INSSEG(COUNT,"POL")
 . D UPDATE^DIE("E","ADDROOT")
 . S COUNT=COUNT+1
 K COUNT,ADDROOT,ADDIEN
 ;unlock file
 L -^DPT(FDAIEN)
 S ^ACSERR(ERRDATE,"FILER  COMPLETE")="("_PIDSEG("NO")_")"_PIDSEGNAME ;)
 G REXIT ;clean-up and quit this routine
 ;
DOUPDATEDIE ;
 ;set fields using $GET ($G) to avoid 'variable undefined' error
 I SSNFOUND S PIDSEG("SSN")="@" ;if ssn exists in database, set ssn to @ to avoid duplicate ssn error on add new entry
 E  S PNTROOT(2,"?+1,",.363)=PIDSEG("SSN")
 E  S PNTROOT(2,"?+1,",.364)=$E(PIDSEG("SSN"),6,9)
 E  S PNTROOT(2,"?+1,",.09)=PIDSEG("SSN")
 I PIDSEG("SSN")="@" S PNTROOT(2,"?+1,",.363)="--"
 I  S PNTROOT(2,"?+1,",.364)=""
 S PNTROOT(2,"?+1,",.01)=$G(PIDSEGNAME)
 S PNTROOT(2,"?+1,",.091)=$G(PIDSEG("REM"))
 S PNTROOT(2,"?+1,",.03)=$G(PIDSEG("DOB"))
 S PNTROOT(2,"?+1,",.02)=$G(PIDSEG("SEX"))
 S PNTROOT(2,"?+1,",.301)="NO"
 S PNTROOT(2,"?+1,",391)="NON-VETERAN (OTHER)"
 S PNTROOT(2,"?+1,",1901)="NO"
 S PNTROOT(2,"?+1,",.111)=$G(PIDSEG("ADDR1"))
 S PNTROOT(2,"?+1,",.112)=$G(PIDSEG("ADDR2"))
 S PNTROOT(2,"?+1,",.114)=$G(PIDSEG("CITY"))
 S PNTROOT(2,"?+1,",.115)=$G(PIDSEG("STATE"))
 S PNTROOT(2,"?+1,",.116)=$G(PIDSEG("ZIP"))
 S PNTROOT(2,"?+1,",.131)=$G(PIDSEG("HPHONE"))
 S PNTROOT(2,"?+1,",.132)=$G(PIDSEG("WPHONE"))
 S PNTROOT(2,"?+1,",.133)=$G(PIDSEG("EMAIL"))
 ;do validation
 D VALS^DIE("","PNTROOT","VALPNTROOT","VALERR")
 N INDEX,ERRNUM,ERRCOUNT
 S INDEX=""
 S ERRCOUNT=1
 F  S INDEX=$O(VALPNTROOT(2,"?+1,",INDEX)) Q:INDEX=""  D
 . I VALPNTROOT(2,"?+1,",INDEX)="^" S ERRNUM=$P(VALERR("DIERR"),"^",1)
 . I  S ^ACSERR(ERRDATE,"ACSPNT","UPDATE ERRNUM")=ERRNUM
 . I  D LOGERR
 . I  S VALFLAG=1
 . I  Q
 K INDEX,ERRNUM,ERRCOUNT
 I VALFLAG G REXIT ;QUIT IF VALIDATION FAILS
 ;
DOUPDATEDIEFILER    ;
 S PNTERR("DIERR")=""
 D UPDATE^DIE("S","VALPNTROOT","FDAIEN","PNTERR")
 M ^CHECK("6UPDATEIEN")=FDAIEN ;)
 I $G(FDAIEN(1))'="" S ^DPT("ACSPATNO",PIDSEG("NO"),FDAIEN(1))="ACTIVE" ;set up my cross-reference
 M ^CHECK("6UPDATE")=PNTERR ;)
 ;FILE HEALTH RECORD NUMBER
 I $G(FDAIEN(1))'="" D EN^ACSPNT3
 ;ADD insurance to new patient
 S ^DPT(FDAIEN(1),.312,"?+",0)="" ;avoid getting error message of var not found when setting policy number for insurance
 N COUNT
 S COUNT=0
 N PNTINSIEN,VALPNTINSROOT,PNTINSROOT
 F  Q:COUNT>INSCOUNT  D
 . S PNTINSIEN="?+1,"_FDAIEN(1)_","
 . S PNTINSROOT(2.312,PNTINSIEN,.01)=INSSEG(COUNT,"NAME")
 . S PNTINSROOT(2.312,PNTINSIEN,17)=INSSEG(COUNT,"NOI")
 . S PNTINSROOT(2.312,PNTINSIEN,16)=INSSEG(COUNT,"REL")
 . S PNTINSROOT(2.312,PNTINSIEN,1)=INSSEG(COUNT,"POL")
 . ;D VALS^DIE("","PNTINSROOT","VALPNTINSROOT","VALERR")
 . D UPDATE^DIE("E","PNTINSROOT") ;SET TO VALPNTINSROOT IF USING VAL^DIE AND TAKE OUT "E" FLAG
 . S COUNT=COUNT+1
 K PNTINSIEN,VALPNTINSROOT,PNTINSROOT
 K COUNT
 S ^ACSERR(ERRDATE,"UPDATE COMPLETE")="("_PIDSEG("NO")_")"_PIDSEGNAME ;)
 G REXIT ;clean-up and quit routine
 ;
 ;
REXIT   ;
 K ERRDATE
 K HLMSG,HEADER,SEG,FDAIEN
 K PIDSEG,PNTROOT,PNTERR,PIDSEGNAME
 K INSCOUNT,INSSEG
 K RESULT,FINDERR
 K SSNRESULT,SSNFINDERR,SSNFOUND
 K VALPNTROOT,VALFLAG,VALERR
 S ^CHECK("9END")="VERSION 3.9   - COMPLETE" ;)
 Q
LOGERR  ;
 F  Q:ERRCOUNT>ERRNUM  D
 . M ^ACSERR(ERRDATE,"ERR TEXT")=VALERR("DIERR",ERRCOUNT,"TEXT")
 . S ERRCOUNT=ERRCOUNT+1
 Q
