- PXSCH4 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- ; Variable List
- ;
- ; DXN800 "PXK" global data for various nodes
- ; DXN802 ""
- ; DXNOD0 ""
- ; DXNOD12 ""
- ; PXSDX The Main Diagnosis
- ; PXSINDX Index for "PXK" global
- ; PXSPR The main provider
- ;
- DIAG ;Create nodes for diagnosis
- Q:'$D(PXS("DIAGNOSIS"))
- S PXSDX=0 F S PXSDX=$O(PXS("DIAGNOSIS",PXSDX)) Q:PXSDX="" D
- .S PXSINDX=PXSINDX+1
- .D DXNOD
- Q
- DXNOD ;
- S DXNOD0="",$P(DXNOD0,"^")=+$G(PXS("DIAGNOSIS",PXSDX))
- S $P(DXNOD0,"^",2)=$G(PXS("PATIENT")) ;PROVIDER
- S $P(DXNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT
- S PXSFILE=9000010.07
- K ^UTILITY("DIQ1",$J)
- S DIC=80,DA=PXSDX,DR=3 D EN^DIQ1
- S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,3))
- K ^UTILITY("DIQ1",$J),DIC,DA,DR
- S $P(DXNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
- Q:$P(DXNOD0,"^",4)=-1
- S DXNOD12=""
- ;S $P(DXNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
- ;S $P(DXNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
- ;S $P(DXNOD12,"^",4)=$G(PXSPR) ;PROVIDER
- ;S $P(DXNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
- ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT
- S DXN800=""
- I $D(PXS("CLASSIFICATION",1)) S $P(DXN800,"^",2)=1
- I $D(PXS("CLASSIFICATION",2)) S $P(DXN800,"^",3)=1
- I $D(PXS("CLASSIFICATION",3)) S $P(DXN800,"^",1)=1
- I $D(PXS("CLASSIFICATION",4)) S $P(DXN800,"^",4)=1
- K ^UTILITY("DIQ1",$J)
- S DIC=80,DA=PXSDX,DR=5,DIQ(0)="E" D EN^DIQ1
- S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,5,"E"))
- ;--DECIDED TO REMOVE CATEGORY
- ;K ^UTILITY("DIQ1",$J)
- ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
- ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"AFTER")=$G(DXNOD0)
- S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"AFTER")=$G(DXNOD12)
- S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"AFTER")=$G(DXN800)
- S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"AFTER")=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=""
- S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=""
- S ^TMP("PXK",$J,"SOR")=8
- S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))
- DXDUP ;Look for duplicates on the same visit
- N XPFG,XP
- S (XPFG,XP)=0 F Q:XPFG S XP=$O(^AUPNVPOV("AD",PXS("VISIT"),XP)) Q:XP="" D
- .I $P(^AUPNVPOV(XP,0),"^",1)=+$G(PXS("DIAGNOSIS",PXSDX)) D
- ..S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=$G(^AUPNVPOV(XP,0))
- ..S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=$G(^AUPNVPOV(XP,12))
- ..S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=$G(^AUPNVPOV(XP,800))
- ..S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=+$G(^AUPNVPOV(XP,802))
- ..S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=XP
- ..S XPFG=1
- Q
- PXSCH4 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- +2 ; Variable List
- +3 ;
- +4 ; DXN800 "PXK" global data for various nodes
- +5 ; DXN802 ""
- +6 ; DXNOD0 ""
- +7 ; DXNOD12 ""
- +8 ; PXSDX The Main Diagnosis
- +9 ; PXSINDX Index for "PXK" global
- +10 ; PXSPR The main provider
- +11 ;
- DIAG ;Create nodes for diagnosis
- +1 IF '$DATA(PXS("DIAGNOSIS"))
- QUIT
- +2 SET PXSDX=0
- FOR
- SET PXSDX=$ORDER(PXS("DIAGNOSIS",PXSDX))
- IF PXSDX=""
- QUIT
- Begin DoDot:1
- +3 SET PXSINDX=PXSINDX+1
- +4 DO DXNOD
- End DoDot:1
- +5 QUIT
- DXNOD ;
- +1 SET DXNOD0=""
- SET $PIECE(DXNOD0,"^")=+$GET(PXS("DIAGNOSIS",PXSDX))
- +2 ;PROVIDER
- SET $PIECE(DXNOD0,"^",2)=$GET(PXS("PATIENT"))
- +3 ;VISIT
- SET $PIECE(DXNOD0,"^",3)=$GET(PXS("VISIT"))
- +4 SET PXSFILE=9000010.07
- +5 KILL ^UTILITY("DIQ1",$JOB)
- +6 SET DIC=80
- SET DA=PXSDX
- SET DR=3
- DO EN^DIQ1
- +7 SET PXSZPN=$GET(^UTILITY("DIQ1",$JOB,80,DA,3))
- +8 KILL ^UTILITY("DIQ1",$JOB),DIC,DA,DR
- +9 SET $PIECE(DXNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
- +10 IF $PIECE(DXNOD0,"^",4)=-1
- QUIT
- +11 SET DXNOD12=""
- +12 ;S $P(DXNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
- +13 ;S $P(DXNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
- +14 ;S $P(DXNOD12,"^",4)=$G(PXSPR) ;PROVIDER
- +15 ;S $P(DXNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
- +16 ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT
- +17 SET DXN800=""
- +18 IF $DATA(PXS("CLASSIFICATION",1))
- SET $PIECE(DXN800,"^",2)=1
- +19 IF $DATA(PXS("CLASSIFICATION",2))
- SET $PIECE(DXN800,"^",3)=1
- +20 IF $DATA(PXS("CLASSIFICATION",3))
- SET $PIECE(DXN800,"^",1)=1
- +21 IF $DATA(PXS("CLASSIFICATION",4))
- SET $PIECE(DXN800,"^",4)=1
- +22 KILL ^UTILITY("DIQ1",$JOB)
- +23 SET DIC=80
- SET DA=PXSDX
- SET DR=5
- SET DIQ(0)="E"
- DO EN^DIQ1
- +24 SET PXSZPN=$GET(^UTILITY("DIQ1",$JOB,80,DA,5,"E"))
- +25 ;--DECIDED TO REMOVE CATEGORY
- +26 ;K ^UTILITY("DIQ1",$J)
- +27 ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
- +28 ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""
- +29 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"AFTER")=$GET(DXNOD0)
- +30 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"BEFORE")=""
- +31 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"AFTER")=$GET(DXNOD12)
- +32 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"BEFORE")=""
- +33 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"AFTER")=$GET(DXN800)
- +34 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"BEFORE")=""
- +35 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,802,"AFTER")=""
- +36 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,802,"BEFORE")=""
- +37 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,"IEN")=""
- +38 SET ^TMP("PXK",$JOB,"SOR")=8
- +39 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=$GET(PXS("VISIT"))
- DXDUP ;Look for duplicates on the same visit
- +1 NEW XPFG,XP
- +2 SET (XPFG,XP)=0
- FOR
- IF XPFG
- QUIT
- SET XP=$ORDER(^AUPNVPOV("AD",PXS("VISIT"),XP))
- IF XP=""
- QUIT
- Begin DoDot:1
- +3 IF $PIECE(^AUPNVPOV(XP,0),"^",1)=+$GET(PXS("DIAGNOSIS",PXSDX))
- Begin DoDot:2
- +4 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"BEFORE")=$GET(^AUPNVPOV(XP,0))
- +5 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"BEFORE")=$GET(^AUPNVPOV(XP,12))
- +6 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"BEFORE")=$GET(^AUPNVPOV(XP,800))
- +7 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,802,"BEFORE")=+$GET(^AUPNVPOV(XP,802))
- +8 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,"IEN")=XP
- +9 SET XPFG=1
- End DoDot:2
- End DoDot:1
- +10 QUIT
