- DGPPAPI ;SLC/SS - Presumptive Psychosis APIs ; 09/22/2020
- ;;5.3;Registration;**1029**;Aug 13, 1993;Build 19
- ;
- ;ICRs:
- ;$$INSUR^IBBAPI - DBIA4419
- ;
- ;/** Returns PP information from the file (#2)
- ;Input:
- ; DFN - IEN in the file (#2)
- ;Output:
- ; Piece #1:
- ; "" patient does not have information about Presumptive Psychosis category in the file (#2)
- ; "Y" patient registered as Presumptive Psychosis patient in the file (#2)
- ; "N" patient settings in the file (#2) contradict with the PP status - cannot be PP because he/she is not a veteran
- ; Piece #2: internal code for the PP category
- ; Piece #3: full name of the PP category
- ;Example:
- ; Y^REJ^REJECTED DUE TO INCOME
- ;*/
- PPINFO(DFN) ;
- N RETVAL
- N DGARR
- D GETS^DIQ(2,DFN_",",".5601;1901","IE","DGARR")
- I $G(DGARR(2,DFN_",",1901,"I"))="N" Q "N" ;patient in not a veteran so she/he can be PP patient
- I $G(DGARR(2,DFN_",",.5601,"I"))="" Q ""
- S RETVAL="Y"_U_$G(DGARR(2,DFN_",",.5601,"I"))_U_$G(DGARR(2,DFN_",",.5601,"E"))
- Q RETVAL
- ;
- ;/** Was patient registered by using PP workaround methods
- ; a.Eligibility Status Data screen 7, section 1
- ; Patient Type = SC VETERAN
- ; VETERAN (Y/N)? = Yes
- ; SERVICE CONNECTED? = Yes
- ; b.Primary Eligibility screen 7, section 3 = SC LESS THAN 50%
- ; c.RATED DISABILITIES screen 11, section 4 = SC%:0
- ; d.RATED DISABILITY screen 11, section 4 = 9410
- ; e.screen 5, field 1 is not null (insurance buffer entry)
- ;
- ;Input parameter
- ; DFN - IEN of the patient file #2
- ;Return values:
- ; N - No: there are no workaround PP settings
- ; Y - Yes, there are workaround PP settings
- ;*/
- PPWRKARN(DGDFN) ;
- N RETVAL,DGSCL50,DGARR
- ; a.Eligibility Status Data screen 7, section 1
- ; Patient Type = SC VETERAN
- ; VETERAN (Y/N)? = Yes
- ; SERVICE CONNECTED? = Yes
- I $$PTYPE(DGDFN)="N" Q "N"
- ;b.Primary Eligibility screen 7, section 3 = SC LESS THAN 50%
- I $$SCLES50(DGDFN)="N" Q "N"
- D GETS^DIQ(2,DGDFN_",",".302;.3721*","I","DGARR")
- ;c.RATED DISABILITIES screen 11, section 4 = SC%:0
- I $G(DGARR(2,DGDFN_",",.302,"I"))'=0 Q "N" ;2,.302 SERVICE CONNECTED PERCENTAGE
- ;d.RATED DISABILITY screen 11, section 4 = 9410 (2,.3721 RATED DISABILITIES (VA) .372;0 POINTER Multiple #2.04)
- I '$$DISABL(.DGARR) Q "N"
- ;e.screen 5, field 1 is not null (insurance buffer entry)
- I '$$INSBUFF(DGDFN) Q "N"
- Q "Y"
- ;
- ; a.Eligibility Status Data screen 7, section 1
- ; Patient Type = SC VETERAN (2,391)
- ; VETERAN (Y/N)? = Yes (2,1901)
- ; SERVICE CONNECTED? = Yes (2,.301)
- ;Input parameter
- ; DFN - IEN of the patient file #2
- ;Return values:
- ; N - No
- ; Y - Yes
- PTYPE(DFN) ;
- N VAEL,VAERR,PTYPE
- D ELIG^VADPT
- ;Patient Type = SC VETERAN (2,391)
- ;VETERAN (Y/N)? = Yes
- ;SERVICE CONNECTED? = Yes (2,.301)
- S PTYPE="N"
- I $P(VAEL(6),U,2)="SC VETERAN",+VAEL(4),+VAEL(3) S PTYPE="Y"
- D KVAR^VADPT
- Q PTYPE
- ;
- ;/** Patient's primary insurance = "SC LESS THAN 50%"?
- ;2,.361 PRIMARY ELIGIBILITY CODE
- ;Input parameter
- ; DFN - IEN of the patient file #2
- ;Return values:
- ; N - No
- ; Y - Yes
- ;*/
- SCLES50(DFN) ;
- N VAEL,X
- D ELIG^VADPT
- I +VAEL(1)>0,$$GET1^DIQ(8,+VAEL(1)_",",8)="SC LESS THAN 50%" Q "Y"
- Q "N"
- ;
- ;/** Does patient have an entry in the insurance buffer?
- ;Input parameter
- ; DFN - IEN of the patient file #2
- ;Return values:
- ; N - No
- ; Y - Yes
- ;*/
- INSBUFF(DFN) ;
- N DGX,DGRTN
- S DGX=$$INSUR^IBBAPI(DFN,"","RAB",.DGRTN,"*")
- I $G(DGRTN("BUFFER"))>0 Q 1
- Q 0
- ;
- ;/** Return the disability DX CODE
- ;Input parameter
- ; IEN31 - IEN of the file #31
- ;Return values:
- ; DX CODE
- ;*/
- DXCODE(IEN31) ;
- N DGARR
- D GETS^DIQ(31,IEN31_",","2","I","DGARR")
- Q $G(DGARR(31,IEN31_",",2,"I"))
- ;
- ;/** check for PP disability settings
- ;Input parameter
- ; IEN31 - IEN of the file #31
- ;Return values:
- ; 1 - PP settings
- ; 0 - no PP settings
- ;*/
- ;
- DISABL(DGARR) ;
- N DGZ,DG31,DGRET
- S DGRET=0
- S DGZ=$O(DGARR(2.04,""))
- I '$G(DGZ) Q 0
- S DG31=$G(DGARR(2.04,DGZ,.01,"I")) ;IEN of the file #31
- I $$DXCODE(DG31)=9410,$G(DGARR(2.04,DGZ,2,"I"))=0 S:'$O(DGARR(2.04,DGZ)) DGRET=1
- Q DGRET
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPPAPI 4198 printed Jan 18, 2025@03:51:28 Page 2
- DGPPAPI ;SLC/SS - Presumptive Psychosis APIs ; 09/22/2020
- +1 ;;5.3;Registration;**1029**;Aug 13, 1993;Build 19
- +2 ;
- +3 ;ICRs:
- +4 ;$$INSUR^IBBAPI - DBIA4419
- +5 ;
- +6 ;/** Returns PP information from the file (#2)
- +7 ;Input:
- +8 ; DFN - IEN in the file (#2)
- +9 ;Output:
- +10 ; Piece #1:
- +11 ; "" patient does not have information about Presumptive Psychosis category in the file (#2)
- +12 ; "Y" patient registered as Presumptive Psychosis patient in the file (#2)
- +13 ; "N" patient settings in the file (#2) contradict with the PP status - cannot be PP because he/she is not a veteran
- +14 ; Piece #2: internal code for the PP category
- +15 ; Piece #3: full name of the PP category
- +16 ;Example:
- +17 ; Y^REJ^REJECTED DUE TO INCOME
- +18 ;*/
- PPINFO(DFN) ;
- +1 NEW RETVAL
- +2 NEW DGARR
- +3 DO GETS^DIQ(2,DFN_",",".5601;1901","IE","DGARR")
- +4 ;patient in not a veteran so she/he can be PP patient
- IF $GET(DGARR(2,DFN_",",1901,"I"))="N"
- QUIT "N"
- +5 IF $GET(DGARR(2,DFN_",",.5601,"I"))=""
- QUIT ""
- +6 SET RETVAL="Y"_U_$GET(DGARR(2,DFN_",",.5601,"I"))_U_$GET(DGARR(2,DFN_",",.5601,"E"))
- +7 QUIT RETVAL
- +8 ;
- +9 ;/** Was patient registered by using PP workaround methods
- +10 ; a.Eligibility Status Data screen 7, section 1
- +11 ; Patient Type = SC VETERAN
- +12 ; VETERAN (Y/N)? = Yes
- +13 ; SERVICE CONNECTED? = Yes
- +14 ; b.Primary Eligibility screen 7, section 3 = SC LESS THAN 50%
- +15 ; c.RATED DISABILITIES screen 11, section 4 = SC%:0
- +16 ; d.RATED DISABILITY screen 11, section 4 = 9410
- +17 ; e.screen 5, field 1 is not null (insurance buffer entry)
- +18 ;
- +19 ;Input parameter
- +20 ; DFN - IEN of the patient file #2
- +21 ;Return values:
- +22 ; N - No: there are no workaround PP settings
- +23 ; Y - Yes, there are workaround PP settings
- +24 ;*/
- PPWRKARN(DGDFN) ;
- +1 NEW RETVAL,DGSCL50,DGARR
- +2 ; a.Eligibility Status Data screen 7, section 1
- +3 ; Patient Type = SC VETERAN
- +4 ; VETERAN (Y/N)? = Yes
- +5 ; SERVICE CONNECTED? = Yes
- +6 IF $$PTYPE(DGDFN)="N"
- QUIT "N"
- +7 ;b.Primary Eligibility screen 7, section 3 = SC LESS THAN 50%
- +8 IF $$SCLES50(DGDFN)="N"
- QUIT "N"
- +9 DO GETS^DIQ(2,DGDFN_",",".302;.3721*","I","DGARR")
- +10 ;c.RATED DISABILITIES screen 11, section 4 = SC%:0
- +11 ;2,.302 SERVICE CONNECTED PERCENTAGE
- IF $GET(DGARR(2,DGDFN_",",.302,"I"))'=0
- QUIT "N"
- +12 ;d.RATED DISABILITY screen 11, section 4 = 9410 (2,.3721 RATED DISABILITIES (VA) .372;0 POINTER Multiple #2.04)
- +13 IF '$$DISABL(.DGARR)
- QUIT "N"
- +14 ;e.screen 5, field 1 is not null (insurance buffer entry)
- +15 IF '$$INSBUFF(DGDFN)
- QUIT "N"
- +16 QUIT "Y"
- +17 ;
- +18 ; a.Eligibility Status Data screen 7, section 1
- +19 ; Patient Type = SC VETERAN (2,391)
- +20 ; VETERAN (Y/N)? = Yes (2,1901)
- +21 ; SERVICE CONNECTED? = Yes (2,.301)
- +22 ;Input parameter
- +23 ; DFN - IEN of the patient file #2
- +24 ;Return values:
- +25 ; N - No
- +26 ; Y - Yes
- PTYPE(DFN) ;
- +1 NEW VAEL,VAERR,PTYPE
- +2 DO ELIG^VADPT
- +3 ;Patient Type = SC VETERAN (2,391)
- +4 ;VETERAN (Y/N)? = Yes
- +5 ;SERVICE CONNECTED? = Yes (2,.301)
- +6 SET PTYPE="N"
- +7 IF $PIECE(VAEL(6),U,2)="SC VETERAN"
- IF +VAEL(4)
- IF +VAEL(3)
- SET PTYPE="Y"
- +8 DO KVAR^VADPT
- +9 QUIT PTYPE
- +10 ;
- +11 ;/** Patient's primary insurance = "SC LESS THAN 50%"?
- +12 ;2,.361 PRIMARY ELIGIBILITY CODE
- +13 ;Input parameter
- +14 ; DFN - IEN of the patient file #2
- +15 ;Return values:
- +16 ; N - No
- +17 ; Y - Yes
- +18 ;*/
- SCLES50(DFN) ;
- +1 NEW VAEL,X
- +2 DO ELIG^VADPT
- +3 IF +VAEL(1)>0
- IF $$GET1^DIQ(8,+VAEL(1)_",",8)="SC LESS THAN 50%"
- QUIT "Y"
- +4 QUIT "N"
- +5 ;
- +6 ;/** Does patient have an entry in the insurance buffer?
- +7 ;Input parameter
- +8 ; DFN - IEN of the patient file #2
- +9 ;Return values:
- +10 ; N - No
- +11 ; Y - Yes
- +12 ;*/
- INSBUFF(DFN) ;
- +1 NEW DGX,DGRTN
- +2 SET DGX=$$INSUR^IBBAPI(DFN,"","RAB",.DGRTN,"*")
- +3 IF $GET(DGRTN("BUFFER"))>0
- QUIT 1
- +4 QUIT 0
- +5 ;
- +6 ;/** Return the disability DX CODE
- +7 ;Input parameter
- +8 ; IEN31 - IEN of the file #31
- +9 ;Return values:
- +10 ; DX CODE
- +11 ;*/
- DXCODE(IEN31) ;
- +1 NEW DGARR
- +2 DO GETS^DIQ(31,IEN31_",","2","I","DGARR")
- +3 QUIT $GET(DGARR(31,IEN31_",",2,"I"))
- +4 ;
- +5 ;/** check for PP disability settings
- +6 ;Input parameter
- +7 ; IEN31 - IEN of the file #31
- +8 ;Return values:
- +9 ; 1 - PP settings
- +10 ; 0 - no PP settings
- +11 ;*/
- +12 ;
- DISABL(DGARR) ;
- +1 NEW DGZ,DG31,DGRET
- +2 SET DGRET=0
- +3 SET DGZ=$ORDER(DGARR(2.04,""))
- +4 IF '$GET(DGZ)
- QUIT 0
- +5 ;IEN of the file #31
- SET DG31=$GET(DGARR(2.04,DGZ,.01,"I"))
- +6 IF $$DXCODE(DG31)=9410
- IF $GET(DGARR(2.04,DGZ,2,"I"))=0
- if '$ORDER(DGARR(2.04,DGZ))
- SET DGRET=1
- +7 QUIT DGRET
- +8 ;