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
|
---|