Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCUTL1

VAFCUTL1.m

Go to the documentation of this file.
  1. VAFCUTL1 ;ISA/RJS,Zoltan - UTILITY ROUTINE FOR CIRN ;APR 6, 1999
  1. ;;5.3;Registration;**149**;Aug 13, 1993
  1. SEND() ;
  1. Q 1
  1. SEND2(DFN,PARAMS) ;
  1. ;This function screens out certain patients
  1. ;the screen can be selected by using the parameter list
  1. ;if the parameter list contains:
  1. ;"D", the function will return a 1 if the patient is a Dead patient
  1. ;"T", the function will return a 1 if the patient is a Test patient
  1. ;"E", the ...................... 1 ................. an Employee
  1. ;"V", the ...................... 1 ................. a Non-Veteran
  1. ;"P", the ...................... 1 ................. Psuedo
  1. ;otherwise the function returns 0
  1. ;
  1. S PARAMS=$G(PARAMS)
  1. N NAME,SSN,DEATH,PATYPE,STRING,RETURN
  1. N DIC,VAFCUTLP,DIQ,DA
  1. S RETURN=0
  1. S DIC=2,DR=".01;.09;.351;391",DA=DFN,DIQ="VAFCUTLP",DIQ(0)="E,I"
  1. D EN^DIQ1
  1. S STRING=""
  1. S NAME=$G(VAFCUTLP(2,DFN,.01,"E"))
  1. S SSN=$G(VAFCUTLP(2,DFN,.09,"E"))
  1. S DEATH=$G(VAFCUTLP(2,DFN,.351,"E"))
  1. S PATYPE=$G(VAFCUTLP(2,DFN,391,"I"))
  1. I PARAMS["D"&(DEATH'="") S STRING="D" ;Dead Pt.
  1. I PARAMS["T" D
  1. . ;Test patients
  1. . I ($E(SSN,1,5)="00000") S STRING=STRING_"T" Q
  1. . I ($E(NAME,1,2)="ZZ") S STRING=STRING_"T"
  1. I PARAMS["E"&($E(NAME,1,3)="EEE") S STRING=STRING_"E" ;Employee
  1. I PARAMS["V"&('$$VETERAN($G(PATYPE))) S STRING=STRING_"V" ;Not Veteran
  1. I PARAMS["P"&(SSN["P") S STRING=STRING_"P"
  1. I STRING'="" S RETURN="1^"_STRING
  1. Q RETURN
  1. VETERAN(PATYPE) ;
  1. I PATYPE="" Q 0
  1. N DIC,DR,DA,DIQ,VETERAN,VAFCUTLV
  1. S DIC=391,DR=".05",DA=PATYPE,DIQ="VAFCUTLV",DIQ(0)="E"
  1. D EN^DIQ1
  1. S VETERAN=$G(VAFCUTLV(391,DA,.05,"E"))
  1. I VETERAN=""!(VETERAN="NO") Q 0
  1. Q 1