source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCUTL1.m@ 1096

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1VAFCUTL1 ;ISA/RJS,Zoltan - UTILITY ROUTINE FOR CIRN ;APR 6, 1999
2 ;;5.3;Registration;**149**;Aug 13, 1993
3SEND() ;
4 Q 1
5SEND2(DFN,PARAMS) ;
6 ;This function screens out certain patients
7 ;the screen can be selected by using the parameter list
8 ;if the parameter list contains:
9 ;"D", the function will return a 1 if the patient is a Dead patient
10 ;"T", the function will return a 1 if the patient is a Test patient
11 ;"E", the ...................... 1 ................. an Employee
12 ;"V", the ...................... 1 ................. a Non-Veteran
13 ;"P", the ...................... 1 ................. Psuedo
14 ;otherwise the function returns 0
15 ;
16 S PARAMS=$G(PARAMS)
17 N NAME,SSN,DEATH,PATYPE,STRING,RETURN
18 N DIC,VAFCUTLP,DIQ,DA
19 S RETURN=0
20 S DIC=2,DR=".01;.09;.351;391",DA=DFN,DIQ="VAFCUTLP",DIQ(0)="E,I"
21 D EN^DIQ1
22 S STRING=""
23 S NAME=$G(VAFCUTLP(2,DFN,.01,"E"))
24 S SSN=$G(VAFCUTLP(2,DFN,.09,"E"))
25 S DEATH=$G(VAFCUTLP(2,DFN,.351,"E"))
26 S PATYPE=$G(VAFCUTLP(2,DFN,391,"I"))
27 I PARAMS["D"&(DEATH'="") S STRING="D" ;Dead Pt.
28 I PARAMS["T" D
29 . ;Test patients
30 . I ($E(SSN,1,5)="00000") S STRING=STRING_"T" Q
31 . I ($E(NAME,1,2)="ZZ") S STRING=STRING_"T"
32 I PARAMS["E"&($E(NAME,1,3)="EEE") S STRING=STRING_"E" ;Employee
33 I PARAMS["V"&('$$VETERAN($G(PATYPE))) S STRING=STRING_"V" ;Not Veteran
34 I PARAMS["P"&(SSN["P") S STRING=STRING_"P"
35 I STRING'="" S RETURN="1^"_STRING
36 Q RETURN
37VETERAN(PATYPE) ;
38 I PATYPE="" Q 0
39 N DIC,DR,DA,DIQ,VETERAN,VAFCUTLV
40 S DIC=391,DR=".05",DA=PATYPE,DIQ="VAFCUTLV",DIQ(0)="E"
41 D EN^DIQ1
42 S VETERAN=$G(VAFCUTLV(391,DA,.05,"E"))
43 I VETERAN=""!(VETERAN="NO") Q 0
44 Q 1
Note: See TracBrowser for help on using the repository browser.