PXCA0 ;ISL/dee - Main routine for PCE Device Interface Module ;11/20/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**5,14,33**;Aug 12, 1996
Q
;
;Variables:
; PXCANPRV Count of the number of providers
; PXCADT Encounter Date/Time
; PXCAPAT Pointer to the patient (9000001 & 2)
; PXCAHLOC Pointer to Hospital Location (44)
; PXCACSTP Pointer to the Credit Stop (40.7)
; PXCAGLB First sub script of ^TMP(
; is "PXK" to send to PXK*
; is "PXCA" to use correct data errors
; PXCAERRS Flag if
; true then builds ^TMP(PXCAGLB,$J, even if there are
; errors, used to build the input data so that the user
; can fix the error and create or correct the entry.
; false does not build ^TMP(PXCAGLB,$J, when there is an
; error in the data need to build it.
; PXCADNUM Index into ^TMP( for the diagnosis on a "DIAGNOSIS/PROBLEM"
; node so that the problem number add after calling
; Problem List
;
EN ;Entry called form PXCAEP.
I '$D(PXCA) S PXCA("ERROR","ENCOUNTER",0,0,0)="Local data array is missing" Q
N PXCADT,PXCAPAT,PXCAHLOC,PXCACSTP,PXCAPPRV,PXCAPDX,PXKDUZ,PXCADNUM
S PXKDUZ=DUZ
D BUILD("PXK",0)
D:'$D(PXCA("ERROR")) FINISH("PXK")
D:$D(PXKERROR) PXKERROR^PXCAERR("PXK")
D EXIT("PXK")
Q
;
BUILD(PXCAGLB,PXCAERRS) ;Takes an PXCA array and builds the ^TMP(PXCAGLB,$J, array.
;
N PXCANPRV
K PXKERROR
K ^TMP(PXCAGLB,$J)
S PXCANPRV=0
;
D PROCESS(.PXCA,1,PXCAERRS)
;
I $D(ZTQUEUED),$D(PXCA("ERROR")) S PXKERROR("PXCA")="There were errors in the data validation in the tasked job, no data was stored."
Q
;
PROCESS(PXCA,PXCABULD,PXCAERRS) ;
N PXCAEVAL S PXCAEVAL=0
I '($D(PXKDUZ)#2) N PXCAPAT,PXCAHLOC,PXCACSTP,PXCAPPRV,PXCAPDX,PXKDUZ,PXCADNUM,PXCADT S PXKDUZ=DUZ
N PXCAPKG,PXCASOR
S PXCAVSIT=""
S PXCAPKG=$$PKG2IEN^VSIT("PX")
S PXCASOR=$P($G(PXCA("SOURCE")),"^",1)
S (PXCAPPRV,PXCAPDX)=0
D
. N PXCAENC
. S PXCAENC=$G(PXCA("ENCOUNTER"))
. S PXCADT=+$P(PXCAENC,"^",1)
. S PXCAPAT=+$P(PXCAENC,"^",2)
. D:PXCAPAT PATINFO^PXCEPAT(.PXCAPAT)
. S PXCAHLOC=+$P(PXCAENC,"^",3)
. ; - ignore stop code passed in and always use the one for
. ; the Hospital Location
. S PXCACSTP=$P($G(^SC(PXCAHLOC,0)),"^",7)
. S PXCAVSIT=$$LOOKVSIT^PXUTLVST(PXCAPAT,PXCADT,PXCAHLOC,PXCACSTP,"","")
. S:PXCAVSIT<1 PXCAVSIT=""
;
I PXCAVSIT>0 D
. ; - return error if trying to send data for a disposition
. I $$DISPOSIT^PXUTL1(PXCAPAT,PXCADT,PXCAVSIT) S PXCA("ERROR","ENCOUNTER",0,0,0)="Dispositions can only be done through the Disposition menu options"
. S PXCAPPRV=$$PRIMVPRV^PXUTL1(PXCAVSIT)
. S PXCAPDX=$$PRIMVPOV^PXUTL1(PXCAVSIT)
;
D ENCOUNT^PXCAVST(.PXCA,PXCABULD,PXCAERRS,.PXCAEVAL)
D SOURCE^PXCASOR(.PXCA,PXCABULD,PXCAERRS)
;
D PROV^PXCAPRV(.PXCA,PXCABULD,PXCAERRS)
D DIAG^PXCAPOV(.PXCA,PXCABULD,PXCAERRS)
D PROC^PXCACPT(.PXCA,PXCABULD,PXCAERRS,PXCAEVAL)
;
D HFACTORS^PXCAHF(.PXCA,PXCABULD,PXCAERRS)
D IMMUN^PXCAVIMM(.PXCA,PXCABULD,PXCAERRS)
D PATED^PXCAPED(.PXCA,PXCABULD,PXCAERRS)
D SKINTEST^PXCASK(.PXCA,PXCABULD,PXCAERRS)
D EXAM^PXCAXAM(.PXCA,PXCABULD,PXCAERRS)
;
;Have Vitals validate its data.
D:$L($T(VALIDATE^GMRVPCE0)) VALIDATE^GMRVPCE0(.PXCA)
;
D PROBLEM^PXCAPL(.PXCA,PXCABULD,PXCAERRS)
;
D DXPL^PXCADXPL(.PXCA,PXCABULD,PXCAERRS) ;must be after DIAG^PXCAPOV
;
;Message if there are no Primary diagnoses
I 'PXCAPDX D
. I $P($G(^PX(815,1,"DI")),"^",3) S PXCA("ERROR","DIAGNOSIS",0,0,2)="There is no Primary Diagnosis for this encounter^"
. E S PXCA("WARNING","DIAGNOSIS",0,0,2)="There is no Primary Diagnosis for this encounter^"
;
D KVA^VADPT
Q
;
FINISH(PXCAGLB) ;
;
;Have Vitals process its data.
I $L($T(VALIDATE^GMRVPCE0)),$L($T(STORE^GMRVPCE0)) D STORE^GMRVPCE0(.PXCA)
;
;Now store the problems into Problem List
; That are in the "PROBLEM" node
D PROBLIST^PXCAPL1
; That are in the "DIAGNOSIS/PROBLEM" node
D PROBLIST^PXCAPL2
;
;Now store the rest of the information in the V-Files
; - save PXKERRORs from problem list calls in PXCAPXKE
N PXCAPXKE
M PXCAPXKE=PXKERROR
D EN1^PXKMAIN
M PXKERROR=PXCAPXKE
; - setting PXCAVSIT for use in PXCAERR
S PXCAVSIT=+$G(^TMP(PXCAGLB,$J,"VST",1,"IEN"))
;Now do the event to tell the rest of the world about the new info.
D EVENT^PXKMAIN
;
Q
;
EXIT(PXCAGLB) ;Done clean up and exit.
K PXKERROR
K ^TMP(PXCAGLB,$J)
D PATKILL^PXCEPAT
Q
;
PXCA0 ;ISL/dee - Main routine for PCE Device Interface Module ;11/20/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,14,33**;Aug 12, 1996
+2 QUIT
+3 ;
+4 ;Variables:
+5 ; PXCANPRV Count of the number of providers
+6 ; PXCADT Encounter Date/Time
+7 ; PXCAPAT Pointer to the patient (9000001 & 2)
+8 ; PXCAHLOC Pointer to Hospital Location (44)
+9 ; PXCACSTP Pointer to the Credit Stop (40.7)
+10 ; PXCAGLB First sub script of ^TMP(
+11 ; is "PXK" to send to PXK*
+12 ; is "PXCA" to use correct data errors
+13 ; PXCAERRS Flag if
+14 ; true then builds ^TMP(PXCAGLB,$J, even if there are
+15 ; errors, used to build the input data so that the user
+16 ; can fix the error and create or correct the entry.
+17 ; false does not build ^TMP(PXCAGLB,$J, when there is an
+18 ; error in the data need to build it.
+19 ; PXCADNUM Index into ^TMP( for the diagnosis on a "DIAGNOSIS/PROBLEM"
+20 ; node so that the problem number add after calling
+21 ; Problem List
+22 ;
EN ;Entry called form PXCAEP.
+1 IF '$DATA(PXCA)
SET PXCA("ERROR","ENCOUNTER",0,0,0)="Local data array is missing"
QUIT
+2 NEW PXCADT,PXCAPAT,PXCAHLOC,PXCACSTP,PXCAPPRV,PXCAPDX,PXKDUZ,PXCADNUM
+3 SET PXKDUZ=DUZ
+4 DO BUILD("PXK",0)
+5 IF '$DATA(PXCA("ERROR"))
DO FINISH("PXK")
+6 IF $DATA(PXKERROR)
DO PXKERROR^PXCAERR("PXK")
+7 DO EXIT("PXK")
+8 QUIT
+9 ;
BUILD(PXCAGLB,PXCAERRS) ;Takes an PXCA array and builds the ^TMP(PXCAGLB,$J, array.
+1 ;
+2 NEW PXCANPRV
+3 KILL PXKERROR
+4 KILL ^TMP(PXCAGLB,$JOB)
+5 SET PXCANPRV=0
+6 ;
+7 DO PROCESS(.PXCA,1,PXCAERRS)
+8 ;
+9 IF $DATA(ZTQUEUED)
IF $DATA(PXCA("ERROR"))
SET PXKERROR("PXCA")="There were errors in the data validation in the tasked job, no data was stored."
+10 QUIT
+11 ;
PROCESS(PXCA,PXCABULD,PXCAERRS) ;
+1 NEW PXCAEVAL
SET PXCAEVAL=0
+2 IF '($DATA(PXKDUZ)#2)
NEW PXCAPAT,PXCAHLOC,PXCACSTP,PXCAPPRV,PXCAPDX,PXKDUZ,PXCADNUM,PXCADT
SET PXKDUZ=DUZ
+3 NEW PXCAPKG,PXCASOR
+4 SET PXCAVSIT=""
+5 SET PXCAPKG=$$PKG2IEN^VSIT("PX")
+6 SET PXCASOR=$PIECE($GET(PXCA("SOURCE")),"^",1)
+7 SET (PXCAPPRV,PXCAPDX)=0
+8 Begin DoDot:1
+9 NEW PXCAENC
+10 SET PXCAENC=$GET(PXCA("ENCOUNTER"))
+11 SET PXCADT=+$PIECE(PXCAENC,"^",1)
+12 SET PXCAPAT=+$PIECE(PXCAENC,"^",2)
+13 IF PXCAPAT
DO PATINFO^PXCEPAT(.PXCAPAT)
+14 SET PXCAHLOC=+$PIECE(PXCAENC,"^",3)
+15 ; - ignore stop code passed in and always use the one for
+16 ; the Hospital Location
+17 SET PXCACSTP=$PIECE($GET(^SC(PXCAHLOC,0)),"^",7)
+18 SET PXCAVSIT=$$LOOKVSIT^PXUTLVST(PXCAPAT,PXCADT,PXCAHLOC,PXCACSTP,"","")
+19 IF PXCAVSIT<1
SET PXCAVSIT=""
End DoDot:1
+20 ;
+21 IF PXCAVSIT>0
Begin DoDot:1
+22 ; - return error if trying to send data for a disposition
+23 IF $$DISPOSIT^PXUTL1(PXCAPAT,PXCADT,PXCAVSIT)
SET PXCA("ERROR","ENCOUNTER",0,0,0)="Dispositions can only be done through the Disposition menu options"
+24 SET PXCAPPRV=$$PRIMVPRV^PXUTL1(PXCAVSIT)
+25 SET PXCAPDX=$$PRIMVPOV^PXUTL1(PXCAVSIT)
End DoDot:1
+26 ;
+27 DO ENCOUNT^PXCAVST(.PXCA,PXCABULD,PXCAERRS,.PXCAEVAL)
+28 DO SOURCE^PXCASOR(.PXCA,PXCABULD,PXCAERRS)
+29 ;
+30 DO PROV^PXCAPRV(.PXCA,PXCABULD,PXCAERRS)
+31 DO DIAG^PXCAPOV(.PXCA,PXCABULD,PXCAERRS)
+32 DO PROC^PXCACPT(.PXCA,PXCABULD,PXCAERRS,PXCAEVAL)
+33 ;
+34 DO HFACTORS^PXCAHF(.PXCA,PXCABULD,PXCAERRS)
+35 DO IMMUN^PXCAVIMM(.PXCA,PXCABULD,PXCAERRS)
+36 DO PATED^PXCAPED(.PXCA,PXCABULD,PXCAERRS)
+37 DO SKINTEST^PXCASK(.PXCA,PXCABULD,PXCAERRS)
+38 DO EXAM^PXCAXAM(.PXCA,PXCABULD,PXCAERRS)
+39 ;
+40 ;Have Vitals validate its data.
+41 IF $LENGTH($TEXT(VALIDATE^GMRVPCE0))
DO VALIDATE^GMRVPCE0(.PXCA)
+42 ;
+43 DO PROBLEM^PXCAPL(.PXCA,PXCABULD,PXCAERRS)
+44 ;
+45 ;must be after DIAG^PXCAPOV
DO DXPL^PXCADXPL(.PXCA,PXCABULD,PXCAERRS)
+46 ;
+47 ;Message if there are no Primary diagnoses
+48 IF 'PXCAPDX
Begin DoDot:1
+49 IF $PIECE($GET(^PX(815,1,"DI")),"^",3)
SET PXCA("ERROR","DIAGNOSIS",0,0,2)="There is no Primary Diagnosis for this encounter^"
+50 IF '$TEST
SET PXCA("WARNING","DIAGNOSIS",0,0,2)="There is no Primary Diagnosis for this encounter^"
End DoDot:1
+51 ;
+52 DO KVA^VADPT
+53 QUIT
+54 ;
FINISH(PXCAGLB) ;
+1 ;
+2 ;Have Vitals process its data.
+3 IF $LENGTH($TEXT(VALIDATE^GMRVPCE0))
IF $LENGTH($TEXT(STORE^GMRVPCE0))
DO STORE^GMRVPCE0(.PXCA)
+4 ;
+5 ;Now store the problems into Problem List
+6 ; That are in the "PROBLEM" node
+7 DO PROBLIST^PXCAPL1
+8 ; That are in the "DIAGNOSIS/PROBLEM" node
+9 DO PROBLIST^PXCAPL2
+10 ;
+11 ;Now store the rest of the information in the V-Files
+12 ; - save PXKERRORs from problem list calls in PXCAPXKE
+13 NEW PXCAPXKE
+14 MERGE PXCAPXKE=PXKERROR
+15 DO EN1^PXKMAIN
+16 MERGE PXKERROR=PXCAPXKE
+17 ; - setting PXCAVSIT for use in PXCAERR
+18 SET PXCAVSIT=+$GET(^TMP(PXCAGLB,$JOB,"VST",1,"IEN"))
+19 ;Now do the event to tell the rest of the world about the new info.
+20 DO EVENT^PXKMAIN
+21 ;
+22 QUIT
+23 ;
EXIT(PXCAGLB) ;Done clean up and exit.
+1 KILL PXKERROR
+2 KILL ^TMP(PXCAGLB,$JOB)
+3 DO PATKILL^PXCEPAT
+4 QUIT
+5 ;
