PXCADX ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for POV ;8/1/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
Q
;
POV(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS node
; Variables
; PXCADIAG Copy of a Diagnosis node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANUMB Count of the number if POVs
; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
;
N PXCAFTER,PXCAITEM
S PXCAFTER=$P(PXCADIAG,"^",1)_"^"
S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",8)_"^^^^^^^^"
S PXCAITEM=$P(PXCADIAG,"^",2)
S PXCAITEM=$S(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
S PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",10)_"^"
S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",7)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,"IEN")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"AFTER")="^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"AFTER")=$P(PXCADIAG,"^",3,6)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"AFTER")=$P(PXCADIAG,"^",9)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
Q
;
;
DX(PXCADXPL,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS/PROBLEM node
; Variables
; PXCADXPL Copy of a DIAGNOSIS/PROBLEM node of the PXCA array
; PXCANUMB Count of the number if POVs
; PXCAPRV Pointer to the provider
; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
; PXCAITEM Temp used to hold an item while processing it
;
N PXCAFTER,PXCAITEM
S PXCAFTER=$P(PXCADXPL,"^",1)_"^"
S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",13)_"^^^^^^^^"
S PXCAITEM=$P(PXCADXPL,"^",2)
S PXCAITEM=$S(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
S PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",3)_"^"
S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",4)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,"IEN")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"AFTER")="^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"AFTER")=$P(PXCADXPL,"^",9,12)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"AFTER")=$P(PXCADXPL,"^",14)
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCADX 2902 printed Dec 13, 2024@02:27:28 Page 2
PXCADX ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for POV ;8/1/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 QUIT
+3 ;
POV(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS node
+1 ; Variables
+2 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
+3 ; PXCAPRV Pointer to the provider (200)
+4 ; PXCANUMB Count of the number if POVs
+5 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
+6 ;
+7 NEW PXCAFTER,PXCAITEM
+8 SET PXCAFTER=$PIECE(PXCADIAG,"^",1)_"^"
+9 SET PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
+10 SET PXCAFTER=PXCAFTER_$PIECE(PXCADIAG,"^",8)_"^^^^^^^^"
+11 SET PXCAITEM=$PIECE(PXCADIAG,"^",2)
+12 SET PXCAITEM=$SELECT(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
+13 SET PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
+14 SET PXCAFTER=PXCAFTER_$PIECE(PXCADIAG,"^",10)_"^"
+15 SET PXCAFTER=PXCAFTER_$PIECE(PXCADIAG,"^",7)
+16 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,"IEN")=""
+17 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,0,"BEFORE")=""
+18 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
+19 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,12,"BEFORE")=""
+20 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,12,"AFTER")="^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")
+21 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,800,"BEFORE")=""
+22 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,800,"AFTER")=$PIECE(PXCADIAG,"^",3,6)
+23 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,802,"BEFORE")=""
+24 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,802,"AFTER")=$PIECE(PXCADIAG,"^",9)
+25 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,812,"BEFORE")=""
+26 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+27 QUIT
+28 ;
+29 ;
DX(PXCADXPL,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS/PROBLEM node
+1 ; Variables
+2 ; PXCADXPL Copy of a DIAGNOSIS/PROBLEM node of the PXCA array
+3 ; PXCANUMB Count of the number if POVs
+4 ; PXCAPRV Pointer to the provider
+5 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
+6 ; PXCAITEM Temp used to hold an item while processing it
+7 ;
+8 NEW PXCAFTER,PXCAITEM
+9 SET PXCAFTER=$PIECE(PXCADXPL,"^",1)_"^"
+10 SET PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
+11 SET PXCAFTER=PXCAFTER_$PIECE(PXCADXPL,"^",13)_"^^^^^^^^"
+12 SET PXCAITEM=$PIECE(PXCADXPL,"^",2)
+13 SET PXCAITEM=$SELECT(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
+14 SET PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
+15 SET PXCAFTER=PXCAFTER_$PIECE(PXCADXPL,"^",3)_"^"
+16 SET PXCAFTER=PXCAFTER_$PIECE(PXCADXPL,"^",4)
+17 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,"IEN")=""
+18 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,0,"BEFORE")=""
+19 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
+20 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,12,"BEFORE")=""
+21 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,12,"AFTER")="^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")
+22 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,800,"BEFORE")=""
+23 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,800,"AFTER")=$PIECE(PXCADXPL,"^",9,12)
+24 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,802,"BEFORE")=""
+25 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,802,"AFTER")=$PIECE(PXCADXPL,"^",14)
+26 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,812,"BEFORE")=""
+27 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+28 QUIT
+29 ;