source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXSCH3.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PXSCH3 ;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 ;
12PRV ;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
20PRVNOD ;
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"))
38PRVDUP ;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
Note: See TracBrowser for help on using the repository browser.