- 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 Mar 13, 2025@21:32:11 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 ;