PXSCH1 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES ;6/11/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
; Variable List
;
; PXS(***) The various pieces of data to move
; PXS1..PXSn Scratch Variables
; PXSCNT Counter- Number of a particular procedure
; PXSCS0 ^TMP("SCCVEVT",$J,"CS",0) node
; PXSCSI0 ^TMP("SCCVEVT",$J,"CS",xx,0) node
; PXSCISPR ^TMP("SCCVEVT",$J,"CS",xx,"PR") node
; PXSOE ^TMP("SCCVEVT",$J,"SDOE",xx,0) node
; PXSDOE IEN on the $O(^TMP("SCCVEVT",$J,"SDOE",0) node
; PXSDVI IEN on the $O(^TMP("SCCVEVT",$J,"CS",0) node
; PXSDX Pointer to the Diagnosis
; PXSIEN Scratch Variable for $Ordering
; PXSINDX increment subscripts in ^TMP("PXK" global
; PXSPR Pointer to the main Provider
;
;
EN1 ;Entry point
N PXS1,PXS2,PXS3,PXS4,PXSCNT,PXSCS0,PXSCSI0,PXSCSIPR,PXSDOE,PXSDVI
N PXSDX,PXSIEN,PXSINDX,PXSOE,PXSPR,CPTNOD0,CPTNOD12,CPTNOD8
N PXSCPT,PXSCPTQ,PXSDX,PXSINDX,PXSPNN,PXSPNNN,PXSPR,PRVNOD0,PRVNOD12
N PXSCT,PXSPRV,DXN800,DXN802,DXNOD0,DXNOD12
N PXSZPN,PXSFILE
;
CHECK ;Check on variables and/or environment
S PXS1=12 Q:$G(PXS1)'[SCCVEVT
Q:$G(SCCVORG)'=2
SET ;Set up needed variables
S PXSDVI=$O(^TMP("SCCVEVT",$J,"CS",0))
S PXSDOE=$O(^TMP("SCCVEVT",$J,"SDOE",0))
LOCLIZE ; Set the tmp global into local array for speed
S PXSCS0=$G(^TMP("SCCVEVT",$J,"CS",0))
S PXSCSI0=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,0))
S PXSCSIPR=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,"PR"))
S PXSOE=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,0))
ARRAY ;Set all of the data into variables
S PXS("DATE")=$P(PXSCS0,"^")
S PXS("PATIENT")=$P(PXSCS0,"^",2)
S PXS("DIVISION")=$P(PXSCS0,"^",3)
S PXS("STOP CODE")=$P(PXSCSI0,"^")
S PXS("CLINIC")=$P(PXSCSI0,"^",3)
S PXS("ELIGIBILITY")=$P(PXSCSI0,"^",4)
S PXS("OUT PAT ENCOU")=PXSDOE
S PXS("PROCEDURE",1)=$P(PXSCSIPR,"^",1)
S PXS("PROCEDURE",2)=$P(PXSCSIPR,"^",2)
S PXS("PROCEDURE",3)=$P(PXSCSIPR,"^",3)
S PXS("PROCEDURE",4)=$P(PXSCSIPR,"^",4)
S PXS("PROCEDURE",5)=$P(PXSCSIPR,"^",5)
S PXS("STOP CODE ORIG")=$P(PXSOE,"^",3)
S PXS("VISIT")=$P(PXSOE,"^",5)
Q:$G(PXS("VISIT"))'>0
S PXS("PARENT ENCOUNTER")=$P(PXSOE,"^",6)
;
DX ;Set Diagnosis array
I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX")) D
.S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN)) Q:PXSIEN="" D
..S PXS("DIAGNOSIS",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN,0))
;
DOC ;Set Provider array
I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR")) D
.S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN)) Q:PXSIEN="" D
..S PXS("PROVIDER",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN,0))
CLASS ;Set Classification array
I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL")) D
.S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN)) Q:PXSIEN="" D
..S PXS("CLASSIFICATION",$P($G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN,0)),"^",1))=""
;
COUNT ;Count up the total number of procedures
N PXS1,PXS2,PXS3,PXS4,PXSCNT
S (PXS1,PXS2,PXS3,PXS4)=0,PXSCNT=0
F S PXS1=$O(PXS("PROCEDURE",PXS1)) Q:PXS1="" D
.S PXS4=$G(PXS("PROCEDURE",PXS1))
.S PXS2="" F S PXS2=$O(PXS("PROCEDURE",PXS2)) Q:PXS2="" D
..I $G(PXS("PROCEDURE",PXS2))=PXS4 S PXSCNT=PXSCNT+1
.I PXS4'="" S PXS("PROC",PXS4)=PXSCNT S PXSCNT=0
;
I $D(PXS("DIAGNOSIS")) S PXSDX=+$G(PXS("DIAGNOSIS",$O(PXS("DIAGNOSIS",0))))
I $D(PXS("PROVIDER")) S PXSPR=+$G(PXS("PROVIDER",$O(PXS("PROVIDER",0))))
S PXSINDX=0
D CPT^PXSCH2,PRV^PXSCH3,DIAG^PXSCH4
D EN1^PXKMAIN
EXIT ;
K PXS,PXSPNN,PXSPNNN,PXKCO
K ^TMP("PXK",$J)
K %DD,%DT,%W,%Y,D,D0,DI,DIC,DQ,X,S,DX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXSCH1 3652 printed Dec 13, 2024@02:31:22 Page 2
PXSCH1 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES ;6/11/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ; Variable List
+3 ;
+4 ; PXS(***) The various pieces of data to move
+5 ; PXS1..PXSn Scratch Variables
+6 ; PXSCNT Counter- Number of a particular procedure
+7 ; PXSCS0 ^TMP("SCCVEVT",$J,"CS",0) node
+8 ; PXSCSI0 ^TMP("SCCVEVT",$J,"CS",xx,0) node
+9 ; PXSCISPR ^TMP("SCCVEVT",$J,"CS",xx,"PR") node
+10 ; PXSOE ^TMP("SCCVEVT",$J,"SDOE",xx,0) node
+11 ; PXSDOE IEN on the $O(^TMP("SCCVEVT",$J,"SDOE",0) node
+12 ; PXSDVI IEN on the $O(^TMP("SCCVEVT",$J,"CS",0) node
+13 ; PXSDX Pointer to the Diagnosis
+14 ; PXSIEN Scratch Variable for $Ordering
+15 ; PXSINDX increment subscripts in ^TMP("PXK" global
+16 ; PXSPR Pointer to the main Provider
+17 ;
+18 ;
EN1 ;Entry point
+1 NEW PXS1,PXS2,PXS3,PXS4,PXSCNT,PXSCS0,PXSCSI0,PXSCSIPR,PXSDOE,PXSDVI
+2 NEW PXSDX,PXSIEN,PXSINDX,PXSOE,PXSPR,CPTNOD0,CPTNOD12,CPTNOD8
+3 NEW PXSCPT,PXSCPTQ,PXSDX,PXSINDX,PXSPNN,PXSPNNN,PXSPR,PRVNOD0,PRVNOD12
+4 NEW PXSCT,PXSPRV,DXN800,DXN802,DXNOD0,DXNOD12
+5 NEW PXSZPN,PXSFILE
+6 ;
CHECK ;Check on variables and/or environment
+1 SET PXS1=12
if $GET(PXS1)'[SCCVEVT
QUIT
+2 if $GET(SCCVORG)'=2
QUIT
SET ;Set up needed variables
+1 SET PXSDVI=$ORDER(^TMP("SCCVEVT",$JOB,"CS",0))
+2 SET PXSDOE=$ORDER(^TMP("SCCVEVT",$JOB,"SDOE",0))
LOCLIZE ; Set the tmp global into local array for speed
+1 SET PXSCS0=$GET(^TMP("SCCVEVT",$JOB,"CS",0))
+2 SET PXSCSI0=$GET(^TMP("SCCVEVT",$JOB,"CS",PXSDVI,0))
+3 SET PXSCSIPR=$GET(^TMP("SCCVEVT",$JOB,"CS",PXSDVI,"PR"))
+4 SET PXSOE=$GET(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,0))
ARRAY ;Set all of the data into variables
+1 SET PXS("DATE")=$PIECE(PXSCS0,"^")
+2 SET PXS("PATIENT")=$PIECE(PXSCS0,"^",2)
+3 SET PXS("DIVISION")=$PIECE(PXSCS0,"^",3)
+4 SET PXS("STOP CODE")=$PIECE(PXSCSI0,"^")
+5 SET PXS("CLINIC")=$PIECE(PXSCSI0,"^",3)
+6 SET PXS("ELIGIBILITY")=$PIECE(PXSCSI0,"^",4)
+7 SET PXS("OUT PAT ENCOU")=PXSDOE
+8 SET PXS("PROCEDURE",1)=$PIECE(PXSCSIPR,"^",1)
+9 SET PXS("PROCEDURE",2)=$PIECE(PXSCSIPR,"^",2)
+10 SET PXS("PROCEDURE",3)=$PIECE(PXSCSIPR,"^",3)
+11 SET PXS("PROCEDURE",4)=$PIECE(PXSCSIPR,"^",4)
+12 SET PXS("PROCEDURE",5)=$PIECE(PXSCSIPR,"^",5)
+13 SET PXS("STOP CODE ORIG")=$PIECE(PXSOE,"^",3)
+14 SET PXS("VISIT")=$PIECE(PXSOE,"^",5)
+15 if $GET(PXS("VISIT"))'>0
QUIT
+16 SET PXS("PARENT ENCOUNTER")=$PIECE(PXSOE,"^",6)
+17 ;
DX ;Set Diagnosis array
+1 IF $DATA(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"DX"))
Begin DoDot:1
+2 SET PXSIEN=0
FOR
SET PXSIEN=$ORDER(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"DX",PXSIEN))
if PXSIEN=""
QUIT
Begin DoDot:2
+3 SET PXS("DIAGNOSIS",PXSIEN)=$GET(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"DX",PXSIEN,0))
End DoDot:2
End DoDot:1
+4 ;
DOC ;Set Provider array
+1 IF $DATA(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"PR"))
Begin DoDot:1
+2 SET PXSIEN=0
FOR
SET PXSIEN=$ORDER(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"PR",PXSIEN))
if PXSIEN=""
QUIT
Begin DoDot:2
+3 SET PXS("PROVIDER",PXSIEN)=$GET(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"PR",PXSIEN,0))
End DoDot:2
End DoDot:1
CLASS ;Set Classification array
+1 IF $DATA(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"CL"))
Begin DoDot:1
+2 SET PXSIEN=0
FOR
SET PXSIEN=$ORDER(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"CL",PXSIEN))
if PXSIEN=""
QUIT
Begin DoDot:2
+3 SET PXS("CLASSIFICATION",$PIECE($GET(^TMP("SCCVEVT",$JOB,"SDOE",PXSDOE,"CL",PXSIEN,0)),"^",1))=""
End DoDot:2
End DoDot:1
+4 ;
COUNT ;Count up the total number of procedures
+1 NEW PXS1,PXS2,PXS3,PXS4,PXSCNT
+2 SET (PXS1,PXS2,PXS3,PXS4)=0
SET PXSCNT=0
+3 FOR
SET PXS1=$ORDER(PXS("PROCEDURE",PXS1))
if PXS1=""
QUIT
Begin DoDot:1
+4 SET PXS4=$GET(PXS("PROCEDURE",PXS1))
+5 SET PXS2=""
FOR
SET PXS2=$ORDER(PXS("PROCEDURE",PXS2))
if PXS2=""
QUIT
Begin DoDot:2
+6 IF $GET(PXS("PROCEDURE",PXS2))=PXS4
SET PXSCNT=PXSCNT+1
End DoDot:2
+7 IF PXS4'=""
SET PXS("PROC",PXS4)=PXSCNT
SET PXSCNT=0
End DoDot:1
+8 ;
+9 IF $DATA(PXS("DIAGNOSIS"))
SET PXSDX=+$GET(PXS("DIAGNOSIS",$ORDER(PXS("DIAGNOSIS",0))))
+10 IF $DATA(PXS("PROVIDER"))
SET PXSPR=+$GET(PXS("PROVIDER",$ORDER(PXS("PROVIDER",0))))
+11 SET PXSINDX=0
+12 DO CPT^PXSCH2
DO PRV^PXSCH3
DO DIAG^PXSCH4
+13 DO EN1^PXKMAIN
EXIT ;
+1 KILL PXS,PXSPNN,PXSPNNN,PXKCO
+2 KILL ^TMP("PXK",$JOB)
+3 KILL %DD,%DT,%W,%Y,D,D0,DI,DIC,DQ,X,S,DX
+4 QUIT
