PXSCH4 ;ISL/JVS,SCK - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**194,199**;Aug 12, 1996;Build 51
; 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
N ICDDATA,PXSDATE
S PXSDATE=$$CSDATE^PXDXUTL($G(PXS("VISIT")))
S PXSFILE=9000010.07
S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXSDX,PXSDATE,"E")
S PXSZPN=$P(ICDDATA,U,4)
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
N PXS1
S PXS1=$P(ICDDATA,U,6)
S PXSZPN=$$GET1^DIQ(80.3,PXS1,.01)
;--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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXSCH4 2787 printed Apr 09, 2024@21:28:16 Page 2
PXSCH4 ;ISL/JVS,SCK - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**194,199**;Aug 12, 1996;Build 51
+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 NEW ICDDATA,PXSDATE
+5 SET PXSDATE=$$CSDATE^PXDXUTL($GET(PXS("VISIT")))
+6 SET PXSFILE=9000010.07
+7 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXSDX,PXSDATE,"E")
+8 SET PXSZPN=$PIECE(ICDDATA,U,4)
+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 NEW PXS1
+23 SET PXS1=$PIECE(ICDDATA,U,6)
+24 SET PXSZPN=$$GET1^DIQ(80.3,PXS1,.01)
+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
+3 FOR
if XPFG
QUIT
SET XP=$ORDER(^AUPNVPOV("AD",PXS("VISIT"),XP))
if XP=""
QUIT
Begin DoDot:1
+4 IF $PIECE(^AUPNVPOV(XP,0),"^",1)=+$GET(PXS("DIAGNOSIS",PXSDX))
Begin DoDot:2
+5 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,0,"BEFORE")=$GET(^AUPNVPOV(XP,0))
+6 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,12,"BEFORE")=$GET(^AUPNVPOV(XP,12))
+7 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,800,"BEFORE")=$GET(^AUPNVPOV(XP,800))
+8 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,802,"BEFORE")=+$GET(^AUPNVPOV(XP,802))
+9 SET ^TMP("PXK",$JOB,"POV",PXSINDX+1,"IEN")=XP
+10 SET XPFG=1
End DoDot:2
End DoDot:1
+11 QUIT
