source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXSCH4.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PXSCH4 ;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 ;
13DIAG ;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
19DXNOD ;
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"))
59DXDUP ;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
Note: See TracBrowser for help on using the repository browser.