VAFCUTL1.m

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 ---VAFCUTL1   1641     printed  Apr 09, 2024@21:50:46                                                                                                                                                                                                    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