1 | PXSCH3 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES-PRV #3 ;6/11/96
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
|
---|
3 | ; Variable List
|
---|
4 | ;
|
---|
5 | ; PRVNOD0 Provider node data
|
---|
6 | ; PRVNOD12 Providr node dat
|
---|
7 | ; PXSCT Counter provider to set Promary/Secondary
|
---|
8 | ; PXSINDX Index for ^tmp("PXK" global
|
---|
9 | ; PXSPR The main Provider
|
---|
10 | ; PXSPRV The Provider being Processed
|
---|
11 | ;
|
---|
12 | PRV ;Create nodes for Providers
|
---|
13 | Q:'$D(PXS("PROVIDER"))
|
---|
14 | S PXSCT=0
|
---|
15 | S PXSPRV=0 F S PXSPRV=$O(PXS("PROVIDER",PXSPRV)) Q:PXSPRV="" D
|
---|
16 | .S PXSINDX=PXSINDX+1
|
---|
17 | .S PXSCT=PXSCT+1
|
---|
18 | .D PRVNOD
|
---|
19 | Q
|
---|
20 | PRVNOD ;
|
---|
21 | S PRVNOD0="",$P(PRVNOD0,"^")=+$G(PXS("PROVIDER",PXSPRV))
|
---|
22 | S $P(PRVNOD0,"^",2)=$G(PXS("PATIENT")) ;PROVIDER
|
---|
23 | S $P(PRVNOD0,"^",3)=$G(PXS("VISIT")) ;VISIT
|
---|
24 | S $P(PRVNOD0,"^",4)=$S(PXSCT=1:"P",PXSCT>1:"S",1:"") ;PRIMARY/SECONDARY
|
---|
25 | S PRVNOD12=""
|
---|
26 | ;S $P(PRVNOD12,"^")=$G(PXS("DATE")) ;DATE AND TIME
|
---|
27 | ;S $P(PRVNOD12,"^",3)=$G(PXS("STOP CODE ORIG")) ;CLINIC STOP
|
---|
28 | ;S $P(PRVNOD12,"^",4)=$G(PXSPR) ;PROVIDER
|
---|
29 | ;S $P(PRVNOD12,"^",5)=$G(PXS("CLINIC")) ;HOSPITAL LOCATION
|
---|
30 | ;S $P(PRVNOD12,"^",7)=$P(PRVNOD0,"^",3) ;SECONDARY VISIT
|
---|
31 | S ^TMP("PXK",$J,"PRV",PXSINDX+1,0,"AFTER")=$G(PRVNOD0)
|
---|
32 | S ^TMP("PXK",$J,"PRV",PXSINDX+1,0,"BEFORE")=""
|
---|
33 | S ^TMP("PXK",$J,"PRV",PXSINDX+1,12,"AFTER")=$G(PRVNOD12)
|
---|
34 | S ^TMP("PXK",$J,"PRV",PXSINDX+1,12,"BEFORE")=""
|
---|
35 | S ^TMP("PXK",$J,"PRV",PXSINDX+1,"IEN")=""
|
---|
36 | S ^TMP("PXK",$J,"SOR")=8
|
---|
37 | S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXS("VISIT"))
|
---|
38 | PRVDUP ;Look for duplicates on the same visit
|
---|
39 | N XPFG,XP
|
---|
40 | S (XPFG,XP)=0 F Q:XPFG S XP=$O(^AUPNVPRV("AD",PXS("VISIT"),XP)) Q:XP="" D
|
---|
41 | .I $P(^AUPNVPRV(XP,0),"^",1)=+$G(PXS("PROVIDER",PXSPRV)) D
|
---|
42 | ..S ^TMP("PXK",$J,"PRV",PXSINDX+1,0,"BEFORE")=$G(^AUPNVPRV(XP,0))
|
---|
43 | ..S ^TMP("PXK",$J,"PRV",PXSINDX+1,12,"BEFORE")=$G(^AUPNVPRV(XP,12))
|
---|
44 | ..S ^TMP("PXK",$J,"PRV",PXSINDX+1,"IEN")=XP
|
---|
45 | ..S XPFG=1
|
---|
46 | Q
|
---|