1 | VAFCUTL1 ;ISA/RJS,Zoltan - UTILITY ROUTINE FOR CIRN ;APR 6, 1999
|
---|
2 | ;;5.3;Registration;**149**;Aug 13, 1993
|
---|
3 | SEND() ;
|
---|
4 | Q 1
|
---|
5 | SEND2(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
|
---|
37 | VETERAN(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
|
---|