source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDSCUTL.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1SDSCUTL ;ALB/JAM/RBS - ASCD Utility Program ; 4/24/07 4:26pm
2 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
3 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
4 ;;known as Service Connected Automated Monitoring (SCAM).
5 ;
6 Q
7 ;
8TYPE ; Select proper user type based on security key.
9 ; called by routines: SDSCEDT,SDSCLST,SDSCMSR,SDSCRP1,SDSCSSD
10 ; sets variables: SDTYPE,SDSCTAT,SDOPT,SDSCCR
11 ; (should be killed by calling routines)
12 I $G(SDTYPE)=""!($G(SDSCTAT)="")!($G(SDOPT)="") D
13 . I $D(^XUSEC("SDSC SUPER",DUZ)) D Q
14 .. ; Supervisor can look at encounters with any status.
15 .. S SDTYPE="S",SDSCTAT="",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
16 .. S SDSCCR=""
17 .. Q
18 . I $D(^XUSEC("SDSC CLINICAL",DUZ)) D Q
19 .. ; Clinician can only look at encounters with a status of REVIEW.
20 .. S SDTYPE="C",SDSCTAT="R",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
21 .. S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
22 .. Q
23 . ; User (default) can only look at encounters with a status of NEW.
24 . S SDTYPE="U",SDSCTAT="N",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
25 . S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
26 . Q
27 Q
28 ;
29NBFP(SDOE) ; Is first-party non-billable based on either clinic, stop code, or patient?
30 N SDOE0,SDPAT,SDOEDT
31 I $G(SDOE)="" Q 0
32 S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
33 I '+$$FIRST^IBRSUTL(SDOE) Q 1
34 Q 0
35 ;
36NBTP(SDOE) ; Is third-party non-billable based on either clinic, stop code, or patient?
37 N SDOE0,SDPAT,SDOEDT,SDCOV
38 I $G(SDOE)="" Q 0
39 S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
40 I '+$$THIRD^IBRSUTL(SDOE) Q 1
41 ; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
42 S SDCOV=$S($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
43 I 'SDCOV Q 1
44 Q 0
45 ;
46SENS(SDFN,SDFLG) ; Check for Sensitive Patient
47 ; Input
48 ; SDFN - Patient IEN
49 ; SDFLG - '1' if called from ListMan edit
50 ; - '0' if called from roll-and-scroll
51 ; Returns
52 ; '0' - OK to view (patient is not sensitive, user has key, or answered 'OK')
53 ; '1' - not OK to view patient (patient is sensitive, user does not have key and answered 'NO')
54 ;
55 N SDANS
56 S SDANS=0
57 I +$P($G(^DGSL(38.1,+SDFN,0)),U,2) D
58 . NEW DIC,Y,DFN,X,VADM
59 . S DFN=SDFN D DEM^VADPT
60 . I $G(SDFLG)=0 W !!,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")",!!
61 . I $G(SDFLG)=1 D FULL^VALM1
62 . S DIC(0)="AE",Y=SDFN
63 . D ^DGSEC
64 . I Y<0 S SDANS=1
65 . I $D(^XUSEC("DG SENSITIVITY",DUZ)) D
66 .. ; If user holds key, prevent sensitive patient warning from scrolling off screen
67 .. N DIR W ! S DIR(0)="E" D ^DIR
68 .D KVA^VADPT
69 Q SDANS
70 ;
71DIV ; Ask for Division
72 N SDN
73 S SDN=0
74 F S SDN=$O(^DG(40.8,SDN)) Q:'SDN D
75 . S DIR("A",SDN)=SDN_" "_$P(^DG(40.8,SDN,0),"^",1)
76 . S SCLN=SDN
77 S SCLN=SCLN+1,DIR("A",SCLN)=SCLN_" ALL"
78 S DIR(0)="L^1:"_SCLN,DIR("B")=SCLN
79 S DIR("A")="Select DIVISION"
80 Q
81 ;
82SRV ; Ask for Clinic Service
83 N TDIR
84 S TDIR="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;R:REHAB MEDICINE;N:NEUROLOGY;0:NONE;"
85 S TDIR=TDIR_"A:ALL"
86 S DIR(0)="S^"_TDIR,DIR("A")="Select SERVICE"
87 Q
88 ;
89STEDT(SDOE,SDTYPE,SDRFLG,SDSCC) ; Store the TRACK EDITS multiple for encounter
90 ; Input:
91 ; SDOE - Encounter IEN
92 ; SDTYPE - Type of User - (Supervisor, Clinician, User)
93 ; SDRFLG - Review flag var
94 ; SDSCC - visit file service connected value (1/0)
95 ;
96 ; Output: none
97 ;
98 ; First add a new entry to the multiple.
99 Q:'$G(SDOE)
100 N DD,DO,X,DA,DIC,DIE,DLAYGO,SDIENS,SDPD,SDVBA,ERR
101 I '$D(^SDSC(409.48,SDOE,1,0)) S ^SDSC(409.48,SDOE,1,0)="^409.481^^"
102 S X=$P(^SDSC(409.48,SDOE,1,0),U,3)+1
103 S DA(1)=SDOE,DA=X,DIC="^SDSC(409.48,"_DA(1)_",1,",DIE=DIC
104 S DLAYGO=409.481,DIC("P")=DLAYGO,DIC(0)="L"
105 K DD,DO
106 D FILE^DICN
107 K DD,DO
108 ; Next update the fields within the multiple.
109 S SDIENS=$$IENS^DILF(.DA)
110 S SDPD(409.481,SDIENS,.02)=DT
111 S SDPD(409.481,SDIENS,.03)=DUZ
112 S SDPD(409.481,SDIENS,.04)=$G(SDTYPE)
113 ; If user answered "REVIEW", set the review flag to "YES".
114 ; Else, set SERV. CONNECT (OK BY USER?) field with current SC status.
115 I $G(SDRFLG)=1 S SDPD(409.481,SDIENS,.06)=1
116 E S SDPD(409.481,SDIENS,.05)=$G(SDSCC)
117 D FILE^DIE("","SDPD","ERR")
118 ;
119 ; -- If not "REVIEW" flag,
120 ; Set file;field (#409.48;.09) SERV. CONNECT (OK BY VBA/ICD?)
121 ; equal to the VBA/ICD9 match result.
122 I '$G(SDRFLG) D
123 . K SDPD,ERR
124 . S SDVBA=$$SC^SDSCAPI(,,SDOE)
125 . S SDPD(409.48,SDOE_",",.09)=$P(SDVBA,U,3)
126 . D FILE^DIE("","SDPD","ERR")
127 Q
128 ;
129CONT ; Standard press RETURN to continue prompt.
130 N DIR,X,Y,DTOUT,DUOUT
131 S DIR(0)="EA"
132 S DIR("A")="Enter RETURN to continue "
133 D ^DIR
134 I $D(DTOUT)!$D(DUOUT) S SDQFLG=1
135 W @IOF,!,"Encounter ",SDOE," (cont'd)"
136 Q
137 ;
138ANCPKG(SCEIEN) ;check if visit came from an ancillary package & if to continue
139 N PCEIEN,DIR,DA,X,Y
140 I '$G(SCEIEN) Q 1
141 S PCEIEN=$P($$GETOE^SDOE(SCEIEN),"^",5) I 'PCEIEN Q 1
142 I $P($G(^AUPNVSIT(PCEIEN,150)),"^",3)'="A" Q 1
143 W $C(7)
144 S DIR("A",1)="WARNING: This encounter came from another package. If it is changed"
145 S DIR("A",2)=" it will not agree with what is in the originating package."
146 S DIR("A",3)=" "
147 S DIR("A")="Do you want to continue with this encounter"
148 S DIR("B")="YES",DIR(0)="Y"
149 D ^DIR
150 Q $S(Y:1,Y<0:1,1:0)
151NCTCL(SDCLIN) ;Checks if a non-count clinic
152 I $P($G(^SC(+SDCLIN,0)),U,17)="Y" Q 1
153 Q 0
154SCHNG(SDOE) ;Checks if a completed encounter SC value was changed.
155 ;Input: SDOE - Encounter IEN
156 ;Output: SC Changed^Orignal Value(1 or 0)^Last Value(1 or 0)
157 ; SC Changed: 0-no change, 1-change
158 ; Null is return if invalid
159 N SDVAL,SDORG,SDUSR
160 I $G(SDOE)="" Q ""
161 S SDVAL=$G(^SDSC(409.48,SDOE,0)) I SDVAL="" Q ""
162 I $P(SDVAL,"^",5)'="C" Q ""
163 S SDORG=$P(SDVAL,U,13),SDUSR=$P(SDVAL,U,6)
164 I SDORG="" S SDORG=1
165 Q $S(SDORG=SDUSR:0,1:1)_U_SDORG_U_SDUSR
166 ;
167LOCK(SCIEN) ;Locks an ASCD record.
168 ; This function locks an ASCD so as to prevent another process from
169 ; editing the same record.
170 ; Input: SCIEN - IEN of record in file #409.48
171 ;
172 ; Output: Returns 1 if lock was successful, 0 otherwise
173 ;
174 I $G(SCIEN) L +^SDSC(409.48,SCIEN):5
175 Q $T
176 ;
177UNLOCK(SCIEN) ;Unlocks an ASCD record.
178 ; This function releases the lock on an ASCD record created by $$LOCK.
179 ; Input: SCIEN - IEN of record in file #409.48
180 ;
181 ; Output: None
182 ;
183 I $G(SCIEN) L -^SDSC(409.48,SCIEN)
184 Q
185 ;
186SCSEL() ;Prompts for the type of service connection records to review.
187 ; Input: No input required
188 ; Output: 1 - SC, 0 - NSC, 2 - All and "" (null)
189 N DIR
190 W !,"Service Connected Encounters Review Selection"
191 S DIR(0)="SO^S:Service Connected;N:Non-Service Connected;A:All"
192 S DIR("B")="S",DIR("A")="Which type do you want to review?"
193 D ^DIR I $D(DIRUT) Q ""
194 Q $S(Y="S":1,Y="N":0,1:2)
Note: See TracBrowser for help on using the repository browser.