[613] | 1 | PXSCH4 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-DIAG #4 ;6/11/96
|
---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
|
---|
| 3 | ; Variable List
|
---|
| 4 | ;
|
---|
| 5 | ; DXN800 "PXK" global data for various nodes
|
---|
| 6 | ; DXN802 ""
|
---|
| 7 | ; DXNOD0 ""
|
---|
| 8 | ; DXNOD12 ""
|
---|
| 9 | ; PXSDX The Main Diagnosis
|
---|
| 10 | ; PXSINDX Index for "PXK" global
|
---|
| 11 | ; PXSPR The main provider
|
---|
| 12 | ;
|
---|
| 13 | DIAG ;Create nodes for diagnosis
|
---|
| 14 | Q:'$D(PXS("DIAGNOSIS"))
|
---|
| 15 | S PXSDX=0 F S PXSDX=$O(PXS("DIAGNOSIS",PXSDX)) Q:PXSDX="" D
|
---|
| 16 | .S PXSINDX=PXSINDX+1
|
---|
| 17 | .D DXNOD
|
---|
| 18 | Q
|
---|
| 19 | DXNOD ;
|
---|
| 20 | S DXNOD0="",$P(DXNOD0,"^")=+$G(PXS("DIAGNOSIS",PXSDX))
|
---|
| 21 | S $P(DXNOD0,"^",2)=$G(PXS("PATIENT")) ;PROVIDER
|
---|
| 22 | S $P(DXNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT
|
---|
| 23 | S PXSFILE=9000010.07
|
---|
| 24 | K ^UTILITY("DIQ1",$J)
|
---|
| 25 | S DIC=80,DA=PXSDX,DR=3 D EN^DIQ1
|
---|
| 26 | S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,3))
|
---|
| 27 | K ^UTILITY("DIQ1",$J),DIC,DA,DR
|
---|
| 28 | S $P(DXNOD0,"^",4)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
|
---|
| 29 | Q:$P(DXNOD0,"^",4)=-1
|
---|
| 30 | S DXNOD12=""
|
---|
| 31 | ;S $P(DXNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
|
---|
| 32 | ;S $P(DXNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
|
---|
| 33 | ;S $P(DXNOD12,"^",4)=$G(PXSPR) ;PROVIDER
|
---|
| 34 | ;S $P(DXNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
|
---|
| 35 | ;S $P(DXNOD12,"^",7)=$P(DXNOD0,"^",3) ;SECONDARY VISIT
|
---|
| 36 | S DXN800=""
|
---|
| 37 | I $D(PXS("CLASSIFICATION",1)) S $P(DXN800,"^",2)=1
|
---|
| 38 | I $D(PXS("CLASSIFICATION",2)) S $P(DXN800,"^",3)=1
|
---|
| 39 | I $D(PXS("CLASSIFICATION",3)) S $P(DXN800,"^",1)=1
|
---|
| 40 | I $D(PXS("CLASSIFICATION",4)) S $P(DXN800,"^",4)=1
|
---|
| 41 | K ^UTILITY("DIQ1",$J)
|
---|
| 42 | S DIC=80,DA=PXSDX,DR=5,DIQ(0)="E" D EN^DIQ1
|
---|
| 43 | S PXSZPN=$G(^UTILITY("DIQ1",$J,80,DA,5,"E"))
|
---|
| 44 | ;--DECIDED TO REMOVE CATEGORY
|
---|
| 45 | ;K ^UTILITY("DIQ1",$J)
|
---|
| 46 | ;S $P(DXN802,"^",1)=+$$PROVNARR^PXAPI(PXSZPN,PXSFILE)
|
---|
| 47 | ;I $P(DXN802,"^",1)'>0 S $P(DXN802,"^",1)=""
|
---|
| 48 | S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"AFTER")=$G(DXNOD0)
|
---|
| 49 | S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=""
|
---|
| 50 | S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"AFTER")=$G(DXNOD12)
|
---|
| 51 | S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=""
|
---|
| 52 | S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"AFTER")=$G(DXN800)
|
---|
| 53 | S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=""
|
---|
| 54 | S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"AFTER")=""
|
---|
| 55 | S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=""
|
---|
| 56 | S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=""
|
---|
| 57 | S ^TMP("PXK",$J,"SOR")=8
|
---|
| 58 | S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))
|
---|
| 59 | DXDUP ;Look for duplicates on the same visit
|
---|
| 60 | N XPFG,XP
|
---|
| 61 | S (XPFG,XP)=0 F Q:XPFG S XP=$O(^AUPNVPOV("AD",PXS("VISIT"),XP)) Q:XP="" D
|
---|
| 62 | .I $P(^AUPNVPOV(XP,0),"^",1)=+$G(PXS("DIAGNOSIS",PXSDX)) D
|
---|
| 63 | ..S ^TMP("PXK",$J,"POV",PXSINDX+1,0,"BEFORE")=$G(^AUPNVPOV(XP,0))
|
---|
| 64 | ..S ^TMP("PXK",$J,"POV",PXSINDX+1,12,"BEFORE")=$G(^AUPNVPOV(XP,12))
|
---|
| 65 | ..S ^TMP("PXK",$J,"POV",PXSINDX+1,800,"BEFORE")=$G(^AUPNVPOV(XP,800))
|
---|
| 66 | ..S ^TMP("PXK",$J,"POV",PXSINDX+1,802,"BEFORE")=+$G(^AUPNVPOV(XP,802))
|
---|
| 67 | ..S ^TMP("PXK",$J,"POV",PXSINDX+1,"IEN")=XP
|
---|
| 68 | ..S XPFG=1
|
---|
| 69 | Q
|
---|