- 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 Jan 18, 2025@03:32: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