PSOREJP7 ;AITC/PD - Third Party Reject Display Screen Cont;03/06/25
;;7.0;OUTPATIENT PHARMACY;**766,767**;DEC 1997;Build 11
;
Q
;
DIA ; Protocol Action to allow user the ability to include a
; Diagnosis Code on the claim
;
N DIAG,PSOET
;
I $$CLOSED^PSOREJP1(RX,REJ,1) Q
;
S PSOET=$$PSOET^PSOREJP3(RX,FILL)
I PSOET D Q
. S VALMSG="DIA not allowed for "_$$ELIGDISP^PSOREJP1(RX,FILL)_" Non-Billable claim."
. S VALMBCK="R"
;
D FULL^VALM1
;
S DIAG=$$DIAG
I DIAG="^" S VALMBCK="R" Q
;
D SEND^PSOREJP3(,,,PSOET,DIAG)
;
Q
;
DIAG() ; Ask for Diagnosis Code
;
N DFLTDX,DIAG,DIR,DIRUT,DTOUT,DUOUT,PSOCLAIM,PSOIEN59,X,Y
;
S PSOIEN59=$$CLAIM^BPSBUTL(RX,FILL) ; ICR# 4719
S PSOCLAIM=$P(PSOIEN59,U,2)
S PSOIEN59=$P(PSOIEN59,U,1)
;
; Diagnosis Code, 424-DO
; Default Diagnosis Code from BPS CLAIMS file, field 424
; Only ICD-10-CM codes are allowed for selection
;
DIAG1 ;
S DIAG=""
S DIR(0)="PO^80:AEQMZ"
S DFLTDX=$P($E($$GET1^DIQ(9002313.0201,1_","_PSOCLAIM_",",424),3,17)," ")
I $G(DFLTDX)'="" S DFLTDX=$E(DFLTDX,1,3)_"."_$E(DFLTDX,4,10)
S DIR("B")=DFLTDX
S DIR("S")="I $P($G(^ICDS($P(^(1),""^"",1),0)),""^"",1)=""ICD-10-CM"""
D ^DIR
I ($D(DUOUT))!($D(DTOUT)) K DIR,X,Y Q "^"
; If no value entered, or @ was entered with no default value, prompt
; user to enter ^ to exit and return them to the Dx prompt
I X=""!((X="@")&(DFLTDX="")) W " ??",!," Enter '^' to exit" G DIAG1
S DIAG=$P(Y,U,2)
I $D(DIRUT),X="@" D I $D(DIRUT) K DIR,X,Y Q "^"
. K DIR,DIRUT,X,Y
. S DIR(0)="Y^E"
. S DIR("A")=" Are you sure you want to delete "_DFLTDX
. S DIR("B")="No"
. S DIAG=DFLTDX
. D ^DIR
. I Y S DIAG="REMOVED"
K DIR,X,Y
;
Q DIAG
;
PREG ; Protocol Action to allow user the ability to populate
; the field 335-2C, Pregnancy Indicator, on the claim.
; 1 = Not Pregnant
; 2 = Pregnant
;
N CLAIM,IEN57,IEN59,PREG,PSOET
;
I $$CLOSED^PSOREJP1(RX,REJ,1) Q
;
S PSOET=$$PSOET^PSOREJP3(RX,FILL)
I PSOET D Q
. S VALMSG="PRG not allowed for "_$$ELIGDISP^PSOREJP1(RX,FILL)_" Non-Billable claim."
. S VALMBCK="R"
;
D FULL^VALM1
;
; Determine the value sent in this field on the most recent
; previous claim (for this Rx/Fill/COB). The default will
; be based on this value, if any; otherwise, no default.
;
S PREG=""
S IEN59=$$IEN59^BPSOSRX(RX,FILL,$$PSOCOB^PSOREJP3(RX,FILL,REJ))
S IEN57=$O(^BPSTL("B",IEN59,""),-1)
I IEN57'="" D
. S CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")
. I CLAIM="" Q
. S PREG=$TR($E($$GET1^DIQ(9002313.02,CLAIM,335),3)," ")
. Q
;
W !
K DIR,X,Y
S DIR(0)="Y^E"
S DIR("A")="Was the patient pregnant on the date of service"
I +PREG S DIR("B")=$S(PREG=1:"No",1:"Yes")
S DIR("?",1)="Enter 'Y' if the patient was pregnant or 'N' if the patient was not"
S DIR("?",2)="pregnant on the date of service. Entering a 'Y' or 'N' value will"
S DIR("?")="resubmit the claim with the respective pregnancy indicator."
D ^DIR
I Y=0 S PREG=1 ; Y=0 means "NO"
E I Y=1 S PREG=2 ; Y=1 means "YES"
E S PREG=""
;
I PREG="" S VALMBCK="R" Q
;
D SEND^PSOREJP3(,,,PSOET,,PREG)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJP7 3175 printed Jan 29, 2026@15:32:35 Page 2
PSOREJP7 ;AITC/PD - Third Party Reject Display Screen Cont;03/06/25
+1 ;;7.0;OUTPATIENT PHARMACY;**766,767**;DEC 1997;Build 11
+2 ;
+3 QUIT
+4 ;
DIA ; Protocol Action to allow user the ability to include a
+1 ; Diagnosis Code on the claim
+2 ;
+3 NEW DIAG,PSOET
+4 ;
+5 IF $$CLOSED^PSOREJP1(RX,REJ,1)
QUIT
+6 ;
+7 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
+8 IF PSOET
Begin DoDot:1
+9 SET VALMSG="DIA not allowed for "_$$ELIGDISP^PSOREJP1(RX,FILL)_" Non-Billable claim."
+10 SET VALMBCK="R"
End DoDot:1
QUIT
+11 ;
+12 DO FULL^VALM1
+13 ;
+14 SET DIAG=$$DIAG
+15 IF DIAG="^"
SET VALMBCK="R"
QUIT
+16 ;
+17 DO SEND^PSOREJP3(,,,PSOET,DIAG)
+18 ;
+19 QUIT
+20 ;
DIAG() ; Ask for Diagnosis Code
+1 ;
+2 NEW DFLTDX,DIAG,DIR,DIRUT,DTOUT,DUOUT,PSOCLAIM,PSOIEN59,X,Y
+3 ;
+4 ; ICR# 4719
SET PSOIEN59=$$CLAIM^BPSBUTL(RX,FILL)
+5 SET PSOCLAIM=$PIECE(PSOIEN59,U,2)
+6 SET PSOIEN59=$PIECE(PSOIEN59,U,1)
+7 ;
+8 ; Diagnosis Code, 424-DO
+9 ; Default Diagnosis Code from BPS CLAIMS file, field 424
+10 ; Only ICD-10-CM codes are allowed for selection
+11 ;
DIAG1 ;
+1 SET DIAG=""
+2 SET DIR(0)="PO^80:AEQMZ"
+3 SET DFLTDX=$PIECE($EXTRACT($$GET1^DIQ(9002313.0201,1_","_PSOCLAIM_",",424),3,17)," ")
+4 IF $GET(DFLTDX)'=""
SET DFLTDX=$EXTRACT(DFLTDX,1,3)_"."_$EXTRACT(DFLTDX,4,10)
+5 SET DIR("B")=DFLTDX
+6 SET DIR("S")="I $P($G(^ICDS($P(^(1),""^"",1),0)),""^"",1)=""ICD-10-CM"""
+7 DO ^DIR
+8 IF ($DATA(DUOUT))!($DATA(DTOUT))
KILL DIR,X,Y
QUIT "^"
+9 ; If no value entered, or @ was entered with no default value, prompt
+10 ; user to enter ^ to exit and return them to the Dx prompt
+11 IF X=""!((X="@")&(DFLTDX=""))
WRITE " ??",!," Enter '^' to exit"
GOTO DIAG1
+12 SET DIAG=$PIECE(Y,U,2)
+13 IF $DATA(DIRUT)
IF X="@"
Begin DoDot:1
+14 KILL DIR,DIRUT,X,Y
+15 SET DIR(0)="Y^E"
+16 SET DIR("A")=" Are you sure you want to delete "_DFLTDX
+17 SET DIR("B")="No"
+18 SET DIAG=DFLTDX
+19 DO ^DIR
+20 IF Y
SET DIAG="REMOVED"
End DoDot:1
IF $DATA(DIRUT)
KILL DIR,X,Y
QUIT "^"
+21 KILL DIR,X,Y
+22 ;
+23 QUIT DIAG
+24 ;
PREG ; Protocol Action to allow user the ability to populate
+1 ; the field 335-2C, Pregnancy Indicator, on the claim.
+2 ; 1 = Not Pregnant
+3 ; 2 = Pregnant
+4 ;
+5 NEW CLAIM,IEN57,IEN59,PREG,PSOET
+6 ;
+7 IF $$CLOSED^PSOREJP1(RX,REJ,1)
QUIT
+8 ;
+9 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
+10 IF PSOET
Begin DoDot:1
+11 SET VALMSG="PRG not allowed for "_$$ELIGDISP^PSOREJP1(RX,FILL)_" Non-Billable claim."
+12 SET VALMBCK="R"
End DoDot:1
QUIT
+13 ;
+14 DO FULL^VALM1
+15 ;
+16 ; Determine the value sent in this field on the most recent
+17 ; previous claim (for this Rx/Fill/COB). The default will
+18 ; be based on this value, if any; otherwise, no default.
+19 ;
+20 SET PREG=""
+21 SET IEN59=$$IEN59^BPSOSRX(RX,FILL,$$PSOCOB^PSOREJP3(RX,FILL,REJ))
+22 SET IEN57=$ORDER(^BPSTL("B",IEN59,""),-1)
+23 IF IEN57'=""
Begin DoDot:1
+24 SET CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")
+25 IF CLAIM=""
QUIT
+26 SET PREG=$TRANSLATE($EXTRACT($$GET1^DIQ(9002313.02,CLAIM,335),3)," ")
+27 QUIT
End DoDot:1
+28 ;
+29 WRITE !
+30 KILL DIR,X,Y
+31 SET DIR(0)="Y^E"
+32 SET DIR("A")="Was the patient pregnant on the date of service"
+33 IF +PREG
SET DIR("B")=$SELECT(PREG=1:"No",1:"Yes")
+34 SET DIR("?",1)="Enter 'Y' if the patient was pregnant or 'N' if the patient was not"
+35 SET DIR("?",2)="pregnant on the date of service. Entering a 'Y' or 'N' value will"
+36 SET DIR("?")="resubmit the claim with the respective pregnancy indicator."
+37 DO ^DIR
+38 ; Y=0 means "NO"
IF Y=0
SET PREG=1
+39 ; Y=1 means "YES"
IF '$TEST
IF Y=1
SET PREG=2
+40 IF '$TEST
SET PREG=""
+41 ;
+42 IF PREG=""
SET VALMBCK="R"
QUIT
+43 ;
+44 DO SEND^PSOREJP3(,,,PSOET,,PREG)
+45 ;
+46 QUIT
+47 ;
