VAFCUTL1 ;ISA/RJS,Zoltan - UTILITY ROUTINE FOR CIRN ;APR 6, 1999
;;5.3;Registration;**149**;Aug 13, 1993
SEND() ;
Q 1
SEND2(DFN,PARAMS) ;
;This function screens out certain patients
;the screen can be selected by using the parameter list
;if the parameter list contains:
;"D", the function will return a 1 if the patient is a Dead patient
;"T", the function will return a 1 if the patient is a Test patient
;"E", the ...................... 1 ................. an Employee
;"V", the ...................... 1 ................. a Non-Veteran
;"P", the ...................... 1 ................. Psuedo
;otherwise the function returns 0
;
S PARAMS=$G(PARAMS)
N NAME,SSN,DEATH,PATYPE,STRING,RETURN
N DIC,VAFCUTLP,DIQ,DA
S RETURN=0
S DIC=2,DR=".01;.09;.351;391",DA=DFN,DIQ="VAFCUTLP",DIQ(0)="E,I"
D EN^DIQ1
S STRING=""
S NAME=$G(VAFCUTLP(2,DFN,.01,"E"))
S SSN=$G(VAFCUTLP(2,DFN,.09,"E"))
S DEATH=$G(VAFCUTLP(2,DFN,.351,"E"))
S PATYPE=$G(VAFCUTLP(2,DFN,391,"I"))
I PARAMS["D"&(DEATH'="") S STRING="D" ;Dead Pt.
I PARAMS["T" D
. ;Test patients
. I ($E(SSN,1,5)="00000") S STRING=STRING_"T" Q
. I ($E(NAME,1,2)="ZZ") S STRING=STRING_"T"
I PARAMS["E"&($E(NAME,1,3)="EEE") S STRING=STRING_"E" ;Employee
I PARAMS["V"&('$$VETERAN($G(PATYPE))) S STRING=STRING_"V" ;Not Veteran
I PARAMS["P"&(SSN["P") S STRING=STRING_"P"
I STRING'="" S RETURN="1^"_STRING
Q RETURN
VETERAN(PATYPE) ;
I PATYPE="" Q 0
N DIC,DR,DA,DIQ,VETERAN,VAFCUTLV
S DIC=391,DR=".05",DA=PATYPE,DIQ="VAFCUTLV",DIQ(0)="E"
D EN^DIQ1
S VETERAN=$G(VAFCUTLV(391,DA,.05,"E"))
I VETERAN=""!(VETERAN="NO") Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCUTL1 1641 printed Dec 13, 2024@03:02:35 Page 2
VAFCUTL1 ;ISA/RJS,Zoltan - UTILITY ROUTINE FOR CIRN ;APR 6, 1999
+1 ;;5.3;Registration;**149**;Aug 13, 1993
SEND() ;
+1 QUIT 1
SEND2(DFN,PARAMS) ;
+1 ;This function screens out certain patients
+2 ;the screen can be selected by using the parameter list
+3 ;if the parameter list contains:
+4 ;"D", the function will return a 1 if the patient is a Dead patient
+5 ;"T", the function will return a 1 if the patient is a Test patient
+6 ;"E", the ...................... 1 ................. an Employee
+7 ;"V", the ...................... 1 ................. a Non-Veteran
+8 ;"P", the ...................... 1 ................. Psuedo
+9 ;otherwise the function returns 0
+10 ;
+11 SET PARAMS=$GET(PARAMS)
+12 NEW NAME,SSN,DEATH,PATYPE,STRING,RETURN
+13 NEW DIC,VAFCUTLP,DIQ,DA
+14 SET RETURN=0
+15 SET DIC=2
SET DR=".01;.09;.351;391"
SET DA=DFN
SET DIQ="VAFCUTLP"
SET DIQ(0)="E,I"
+16 DO EN^DIQ1
+17 SET STRING=""
+18 SET NAME=$GET(VAFCUTLP(2,DFN,.01,"E"))
+19 SET SSN=$GET(VAFCUTLP(2,DFN,.09,"E"))
+20 SET DEATH=$GET(VAFCUTLP(2,DFN,.351,"E"))
+21 SET PATYPE=$GET(VAFCUTLP(2,DFN,391,"I"))
+22 ;Dead Pt.
IF PARAMS["D"&(DEATH'="")
SET STRING="D"
+23 IF PARAMS["T"
Begin DoDot:1
+24 ;Test patients
+25 IF ($EXTRACT(SSN,1,5)="00000")
SET STRING=STRING_"T"
QUIT
+26 IF ($EXTRACT(NAME,1,2)="ZZ")
SET STRING=STRING_"T"
End DoDot:1
+27 ;Employee
IF PARAMS["E"&($EXTRACT(NAME,1,3)="EEE")
SET STRING=STRING_"E"
+28 ;Not Veteran
IF PARAMS["V"&('$$VETERAN($GET(PATYPE)))
SET STRING=STRING_"V"
+29 IF PARAMS["P"&(SSN["P")
SET STRING=STRING_"P"
+30 IF STRING'=""
SET RETURN="1^"_STRING
+31 QUIT RETURN
VETERAN(PATYPE) ;
+1 IF PATYPE=""
QUIT 0
+2 NEW DIC,DR,DA,DIQ,VETERAN,VAFCUTLV
+3 SET DIC=391
SET DR=".05"
SET DA=PATYPE
SET DIQ="VAFCUTLV"
SET DIQ(0)="E"
+4 DO EN^DIQ1
+5 SET VETERAN=$GET(VAFCUTLV(391,DA,.05,"E"))
+6 IF VETERAN=""!(VETERAN="NO")
QUIT 0
+7 QUIT 1
