- 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 Feb 19, 2025@00:28:37 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