[613] | 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
|
---|