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 Sep 23, 2025@20:26:40 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 ;
