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

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1PXSCH1 ;ISL/JVS - SCHEDULING REDESIGN PROCEDURES ;6/11/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3 ; Variable List
4 ;
5 ; PXS(***) The various pieces of data to move
6 ; PXS1..PXSn Scratch Variables
7 ; PXSCNT Counter- Number of a particular procedure
8 ; PXSCS0 ^TMP("SCCVEVT",$J,"CS",0) node
9 ; PXSCSI0 ^TMP("SCCVEVT",$J,"CS",xx,0) node
10 ; PXSCISPR ^TMP("SCCVEVT",$J,"CS",xx,"PR") node
11 ; PXSOE ^TMP("SCCVEVT",$J,"SDOE",xx,0) node
12 ; PXSDOE IEN on the $O(^TMP("SCCVEVT",$J,"SDOE",0) node
13 ; PXSDVI IEN on the $O(^TMP("SCCVEVT",$J,"CS",0) node
14 ; PXSDX Pointer to the Diagnosis
15 ; PXSIEN Scratch Variable for $Ordering
16 ; PXSINDX increment subscripts in ^TMP("PXK" global
17 ; PXSPR Pointer to the main Provider
18 ;
19 ;
20EN1 ;Entry point
21 N PXS1,PXS2,PXS3,PXS4,PXSCNT,PXSCS0,PXSCSI0,PXSCSIPR,PXSDOE,PXSDVI
22 N PXSDX,PXSIEN,PXSINDX,PXSOE,PXSPR,CPTNOD0,CPTNOD12,CPTNOD8
23 N PXSCPT,PXSCPTQ,PXSDX,PXSINDX,PXSPNN,PXSPNNN,PXSPR,PRVNOD0,PRVNOD12
24 N PXSCT,PXSPRV,DXN800,DXN802,DXNOD0,DXNOD12
25 N PXSZPN,PXSFILE
26 ;
27CHECK ;Check on variables and/or environment
28 S PXS1=12 Q:$G(PXS1)'[SCCVEVT
29 Q:$G(SCCVORG)'=2
30SET ;Set up needed variables
31 S PXSDVI=$O(^TMP("SCCVEVT",$J,"CS",0))
32 S PXSDOE=$O(^TMP("SCCVEVT",$J,"SDOE",0))
33LOCLIZE ; Set the tmp global into local array for speed
34 S PXSCS0=$G(^TMP("SCCVEVT",$J,"CS",0))
35 S PXSCSI0=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,0))
36 S PXSCSIPR=$G(^TMP("SCCVEVT",$J,"CS",PXSDVI,"PR"))
37 S PXSOE=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,0))
38ARRAY ;Set all of the data into variables
39 S PXS("DATE")=$P(PXSCS0,"^")
40 S PXS("PATIENT")=$P(PXSCS0,"^",2)
41 S PXS("DIVISION")=$P(PXSCS0,"^",3)
42 S PXS("STOP CODE")=$P(PXSCSI0,"^")
43 S PXS("CLINIC")=$P(PXSCSI0,"^",3)
44 S PXS("ELIGIBILITY")=$P(PXSCSI0,"^",4)
45 S PXS("OUT PAT ENCOU")=PXSDOE
46 S PXS("PROCEDURE",1)=$P(PXSCSIPR,"^",1)
47 S PXS("PROCEDURE",2)=$P(PXSCSIPR,"^",2)
48 S PXS("PROCEDURE",3)=$P(PXSCSIPR,"^",3)
49 S PXS("PROCEDURE",4)=$P(PXSCSIPR,"^",4)
50 S PXS("PROCEDURE",5)=$P(PXSCSIPR,"^",5)
51 S PXS("STOP CODE ORIG")=$P(PXSOE,"^",3)
52 S PXS("VISIT")=$P(PXSOE,"^",5)
53 Q:$G(PXS("VISIT"))'>0
54 S PXS("PARENT ENCOUNTER")=$P(PXSOE,"^",6)
55 ;
56DX ;Set Diagnosis array
57 I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX")) D
58 .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN)) Q:PXSIEN="" D
59 ..S PXS("DIAGNOSIS",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"DX",PXSIEN,0))
60 ;
61DOC ;Set Provider array
62 I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR")) D
63 .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN)) Q:PXSIEN="" D
64 ..S PXS("PROVIDER",PXSIEN)=$G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"PR",PXSIEN,0))
65CLASS ;Set Classification array
66 I $D(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL")) D
67 .S PXSIEN=0 F S PXSIEN=$O(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN)) Q:PXSIEN="" D
68 ..S PXS("CLASSIFICATION",$P($G(^TMP("SCCVEVT",$J,"SDOE",PXSDOE,"CL",PXSIEN,0)),"^",1))=""
69 ;
70COUNT ;Count up the total number of procedures
71 N PXS1,PXS2,PXS3,PXS4,PXSCNT
72 S (PXS1,PXS2,PXS3,PXS4)=0,PXSCNT=0
73 F S PXS1=$O(PXS("PROCEDURE",PXS1)) Q:PXS1="" D
74 .S PXS4=$G(PXS("PROCEDURE",PXS1))
75 .S PXS2="" F S PXS2=$O(PXS("PROCEDURE",PXS2)) Q:PXS2="" D
76 ..I $G(PXS("PROCEDURE",PXS2))=PXS4 S PXSCNT=PXSCNT+1
77 .I PXS4'="" S PXS("PROC",PXS4)=PXSCNT S PXSCNT=0
78 ;
79 I $D(PXS("DIAGNOSIS")) S PXSDX=+$G(PXS("DIAGNOSIS",$O(PXS("DIAGNOSIS",0))))
80 I $D(PXS("PROVIDER")) S PXSPR=+$G(PXS("PROVIDER",$O(PXS("PROVIDER",0))))
81 S PXSINDX=0
82 D CPT^PXSCH2,PRV^PXSCH3,DIAG^PXSCH4
83 D EN1^PXKMAIN
84EXIT ;
85 K PXS,PXSPNN,PXSPNNN,PXKCO
86 K ^TMP("PXK",$J)
87 K %DD,%DT,%W,%Y,D,D0,DI,DIC,DQ,X,S,DX
88 Q
Note: See TracBrowser for help on using the repository browser.