PSOREJU2 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04
;;7.0;OUTPATIENT PHARMACY;**148,260,287**;DEC 1997;Build 77
;Reference to $$NABP^BPSBUTL supported by IA 4719
;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714
;
GET(RX,RFL,REJDATA,REJID,OKCL,CODE) ;
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) REJDATA(REJECT IEN,FIELD) - Array where these Reject fields will be returned:
; "CODE" - Reject Code (79 or 88)
; "DATE/TIME" - DATE/TIME Reject was detected
; "PAYER MESSAGE" - Message returned by the payer
; "REASON" - Reject Reason description (from payer)
; "INSURANCE NAME" - Patient's Insurance Company Name
; "GROUP NAME" - Patient's Insurance Group Name
; "GROUP NUMBER" - Patient's Insurance Group Number
; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
; "PLAN CONTACT" - Plan's Contact (eg., "1-800-...")
; "PLAN PREVIOUS FILL DATE" - Last time Rx was paid by payer
; "STATUS" - REJECTS status ("OPEN/UNRESOLVED" or "CLOSED/RESOLVED")
; "DUR TEXT" - Payer's DUR description
; "OTHER REJECTS" - Other Rejects on the same response
; "REASON SVC CODE" - Reason for Service Code
; If REJECT is closed, the following fields will be returned:
; "CLA CODE" - Clarification Code submitted
; "PRIOR AUTH TYPE" - Prior Authorization Type
; "PRIOR AUTH NUMBER" - Prior Authorization Type
; "CLOSED DATE/TIME" - DATE/TIME Reject was closed
; "CLOSED BY" - Name of the user responsible for closing Reject
; "CLOSE REASON" - Reason for closing Reject (text)
; "CLOSE COMMENTS" - User entered comments at close
; (o) REJID - REJECT IEN in the PRESCRIPTION file for retrieve this REJECT
; (o) OKCL - If set to 1, CLOSED REJECTs will also be returned
; (o) CODE - Only REJECTs with this CODE should be returned
;
N REJS,ARRAY,REJFLD,IDX,COM,Z
;
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
;
K REJDATA
I '$O(^PSRX(RX,"REJ",0)) Q
;
K REJS S RFL=+$G(RFL)
I $G(REJID) D
. I +$P($G(^PSRX(RX,"REJ",REJID,0)),"^",4)'=RFL Q
. I '$G(OKCL),$P($G(^PSRX(RX,"REJ",REJID,0)),"^",5) Q
. S REJS(REJID)=""
E D
. S IDX=999
. F S IDX=$O(^PSRX(RX,"REJ",IDX),-1) Q:'IDX D
. . I +$P($G(^PSRX(RX,"REJ",IDX,0)),"^",4)'=RFL Q
. . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",IDX,0)),"^",5) Q
. . S REJS(IDX)=""
I '$D(REJS) Q
;
S IDX=0
F S IDX=$O(REJS(IDX)) Q:'IDX D
. K ARRAY D GETS^DIQ(52.25,IDX_","_RX_",","*","","ARRAY")
. K REJFLD M REJFLD=ARRAY(52.25,IDX_","_RX_",")
. I $G(CODE),REJFLD(.01)'=CODE Q
. S REJDATA(IDX,"CODE")=$G(REJFLD(.01))
. S REJDATA(IDX,"DATE/TIME")=$G(REJFLD(1))
. S REJDATA(IDX,"PAYER MESSAGE")=$G(REJFLD(2))
. S REJDATA(IDX,"REASON")=$G(REJFLD(3))
. S REJDATA(IDX,"PHARMACIST")=$G(REJFLD(4))
. S REJDATA(IDX,"INSURANCE NAME")=$G(REJFLD(20))
. S REJDATA(IDX,"GROUP NAME")=$G(REJFLD(6))
. S REJDATA(IDX,"GROUP NUMBER")=$G(REJFLD(21))
. S REJDATA(IDX,"CARDHOLDER ID")=$G(REJFLD(22))
. S REJDATA(IDX,"PLAN CONTACT")=$G(REJFLD(7))
. S REJDATA(IDX,"PLAN PREVIOUS FILL DATE")=$G(REJFLD(8))
. S REJDATA(IDX,"STATUS")=$G(REJFLD(9))
. S REJDATA(IDX,"OTHER REJECTS")=$G(REJFLD(17))
. S REJDATA(IDX,"DUR TEXT")=$G(REJFLD(18))
. S REJDATA(IDX,"REASON SVC CODE")=$G(REJFLD(14))
. S REJDATA(IDX,"RESPONSE IEN")=$G(REJFLD(16))
. I '$G(OKCL) Q
. S REJDATA(IDX,"CLOSED DATE/TIME")=$G(REJFLD(10))
. S REJDATA(IDX,"CLOSED BY")=$G(REJFLD(11))
. S REJDATA(IDX,"CLOSE REASON")=$G(REJFLD(12))
. S REJDATA(IDX,"CLOSE COMMENTS")=$G(REJFLD(13))
. S REJDATA(IDX,"COD1")=$G(REJFLD(14))
. S REJDATA(IDX,"COD2")=$G(REJFLD(15))
. S REJDATA(IDX,"COD3")=$G(REJFLD(19))
. S REJDATA(IDX,"CLA CODE")=$G(REJFLD(24))
. S REJDATA(IDX,"PRIOR AUTH TYPE")=$G(REJFLD(25))
. S REJDATA(IDX,"PRIOR AUTH NUMBER")=$G(REJFLD(26))
. S COM=0 F S COM=$O(^PSRX(RX,"REJ",IDX,"COM",COM)) Q:'COM D
. . S Z=^PSRX(RX,"REJ",IDX,"COM",COM,0)
. . S REJDATA(IDX,"COMMENTS",COM,"DATE/TIME")=$P(Z,"^")
. . S REJDATA(IDX,"COMMENTS",COM,"USER")=$P(Z,"^",2)
. . S REJDATA(IDX,"COMMENTS",COM,"COMMENTS")=$P(Z,"^",3)
Q
;
HELP(OPTS) ; Display the Help Text for the DUR handling options (OVERRIDE/IGNORE/STOP/QUIT)
;
I OPTS["O" D
. W !?1,"(O)verride - This option will provide the prompts for the code sets needed to"
. W !?1," override this reject and get a payable 3rd party claim. Before"
. W !?1," you select this option, you may need to call the 3rd party payer"
. W !?1," to determine which code sets are needed to override a particular"
. W !?1," reject. Once the proper override is accepted the label will print"
. W !?1," and the prescription can be filled."
;
I OPTS["I" D
. W !?1,"(I)gnore - Choosing Ignore will by-pass 3rd party processing and will allow"
. W !?1," you to print a label and fill the prescription. This essentially"
. W !?1," ignores the clinical safety issues suggested by the 3rd party"
. W !?1," payer and will NOT result in a payable claim."
;
I OPTS["Q" D
. W !?1,"(Q)uit - Choosing Quit will postpone the processing of this prescription"
. W !?1," until this 3rd party reject is resolved. A label will not be"
. W !?1," printed for this prescription and it can not be filled/dispensed"
. W !?1," until this reject is resolved. Rejects can be resolved through"
. W !?1," the Worklist option under the ePharmacy menu."
Q
;
DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
N TXT,DVINFO,NCPNPI
S DVINFO="Division : "_$$GET1^DIQ(59,+$$RXSITE^PSOBPSUT(RX,RFL),.01)
S NCPNPI=$P($$NABP^BPSBUTL(RX,RFL)," ")
S $E(DVINFO,$S($G(LM):58,1:51))=$S($L(NCPNPI)=7:"NCPDP",1:" NPI")_"#: "_NCPNPI
Q DVINFO
;
PTINFO(RX,LM) ; Returns header displayable Patient Information
;Input: (r) RX - Rx IEN (#52)
; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
N DFN,VADM,PTINFO
S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
S PTINFO="Patient : "_$E($G(VADM(1)),1,$S($G(LM):24,1:20))_"("_$P($G(VADM(2)),"^",2)_")"
S PTINFO=PTINFO_" Sex: "_$P($G(VADM(5)),"^")
S $E(PTINFO,$S($G(LM):61,1:54))="DOB: "_$P($G(VADM(3)),"^",2)_"("_$P($G(VADM(4)),"^")_")"
Q PTINFO
;
RETRXF(RX,RFL,ONOFF) ; - Set/Reset the Re-transmission flag
;Input: (r) RX - Rx IEN (#52)
; (r) RFL - Refill IEN (#52.1)
; (o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF)
N DA,DIE,DR
S DR="82///"_$S($G(ONOFF):"YES",1:"@")
I 'RFL S DA=RX,DIE="^PSRX("
I RFL S DA(1)=RX,DA=RFL,DIE="^PSRX("_RX_",1,"
D ^DIE
Q
;
REASON(TXT) ; Extracts the Reason for service code from the REASON text field
; Input: (r) TXT - Reason text (e.g., NN Reason for Service Code Text)
;Output: REASON - NN (if on valid and on file (#9002313.23), null otherwise)
N REASON,DIC,X,Y
S REASON=$P(TXT," ") I $L(REASON)'=2 Q ""
S DIC=9002313.23,X=REASON D ^DIC I Y<0 Q ""
Q REASON
;
SETOPN(RX,REJ) ; - Set the Reject RE-OPENED flag to YES
;Input: (r) RX - Rx IEN (#52)
; (r) REJ - Reject IEN (#52.25)
;
I '$D(^PSRX(RX,"REJ",REJ)) Q
N DIE,DA,DR
S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=REJ,DR="23///YES" D ^DIE
Q
;
PRT(FIELD,P,L) ; Sets the lines for fields that require text wrapping
;Input: FIELD - Subscript name from the DATA(REJ,FIELD) array
; P - Position where the content should be printed
; L - Lenght of the text on each line
N TXT,I
S TXT=DATA(REJ,FIELD) I $L(TXT)'>L W ?P,TXT Q
F I=1:1 Q:TXT="" D
. I I=1 W ?P,$E(TXT,1,L),! S TXT=$E(TXT,L+1,999) Q
. W ?P,$E(TXT,1,L) S TXT=$E(TXT,L+1,999) W:TXT'="" !
Q
;
PA() ; - Ask for Prior Authorization Type and Number
;Output:(PAT^PAN) PAT - Prior Authorization Type (See DD File#52,
; Sub-file#52.25,field#25 for possible values)
; PAN - Prior Authorization Number (11 digits)
;
N DIR,Y,DIRUT,DIROUT,PAT,PAN
S DIR(0)="52.25,25",DIR("A")=" Prior Authorization Type",DIR("B")="0"
S (DIR("?"),DIR("??"))="^D PAHLP^PSOREJU2"
D ^DIR I $D(DIRUT)!$D(DIROUT) Q "^"
S PAT=Y
K DIR S DIR(0)="52.25,26",DIR("A")="Prior Authorization Number"
S DIR("?")="^D PANHLP^PSOREJU2",DIR("??")=""
D ^DIR I (Y["^")!$D(DIROUT) Q "^"
S PAN=Y
Q (PAT_"^"_PAN)
;
PAHLP ; Prior Authorization Type Help
W !?9,"EPSDT - Early Periodic Screening Diagnosis Treatment"
W !?9,"AFDC - Aid to Family with Dependent Children"
Q
;
PANHLP ; Prior Authorization Number Help
W "OR you may leave it blank if the claim does not require a number."
Q
PSOREJU2 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04
+1 ;;7.0;OUTPATIENT PHARMACY;**148,260,287**;DEC 1997;Build 77
+2 ;Reference to $$NABP^BPSBUTL supported by IA 4719
+3 ;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714
+4 ;
GET(RX,RFL,REJDATA,REJID,OKCL,CODE) ;
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (r) REJDATA(REJECT IEN,FIELD) - Array where these Reject fields will be returned:
+4 ; "CODE" - Reject Code (79 or 88)
+5 ; "DATE/TIME" - DATE/TIME Reject was detected
+6 ; "PAYER MESSAGE" - Message returned by the payer
+7 ; "REASON" - Reject Reason description (from payer)
+8 ; "INSURANCE NAME" - Patient's Insurance Company Name
+9 ; "GROUP NAME" - Patient's Insurance Group Name
+10 ; "GROUP NUMBER" - Patient's Insurance Group Number
+11 ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
+12 ; "PLAN CONTACT" - Plan's Contact (eg., "1-800-...")
+13 ; "PLAN PREVIOUS FILL DATE" - Last time Rx was paid by payer
+14 ; "STATUS" - REJECTS status ("OPEN/UNRESOLVED" or "CLOSED/RESOLVED")
+15 ; "DUR TEXT" - Payer's DUR description
+16 ; "OTHER REJECTS" - Other Rejects on the same response
+17 ; "REASON SVC CODE" - Reason for Service Code
+18 ; If REJECT is closed, the following fields will be returned:
+19 ; "CLA CODE" - Clarification Code submitted
+20 ; "PRIOR AUTH TYPE" - Prior Authorization Type
+21 ; "PRIOR AUTH NUMBER" - Prior Authorization Type
+22 ; "CLOSED DATE/TIME" - DATE/TIME Reject was closed
+23 ; "CLOSED BY" - Name of the user responsible for closing Reject
+24 ; "CLOSE REASON" - Reason for closing Reject (text)
+25 ; "CLOSE COMMENTS" - User entered comments at close
+26 ; (o) REJID - REJECT IEN in the PRESCRIPTION file for retrieve this REJECT
+27 ; (o) OKCL - If set to 1, CLOSED REJECTs will also be returned
+28 ; (o) CODE - Only REJECTs with this CODE should be returned
+29 ;
+30 NEW REJS,ARRAY,REJFLD,IDX,COM,Z
+31 ;
+32 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+33 ;
+34 KILL REJDATA
+35 IF '$ORDER(^PSRX(RX,"REJ",0))
QUIT
+36 ;
+37 KILL REJS
SET RFL=+$GET(RFL)
+38 IF $GET(REJID)
Begin DoDot:1
+39 IF +$PIECE($GET(^PSRX(RX,"REJ",REJID,0)),"^",4)'=RFL
QUIT
+40 IF '$GET(OKCL)
IF $PIECE($GET(^PSRX(RX,"REJ",REJID,0)),"^",5)
QUIT
+41 SET REJS(REJID)=""
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 SET IDX=999
+44 FOR
SET IDX=$ORDER(^PSRX(RX,"REJ",IDX),-1)
IF 'IDX
QUIT
Begin DoDot:2
+45 IF +$PIECE($GET(^PSRX(RX,"REJ",IDX,0)),"^",4)'=RFL
QUIT
+46 IF '$GET(OKCL)
IF $PIECE($GET(^PSRX(RX,"REJ",IDX,0)),"^",5)
QUIT
+47 SET REJS(IDX)=""
End DoDot:2
End DoDot:1
+48 IF '$DATA(REJS)
QUIT
+49 ;
+50 SET IDX=0
+51 FOR
SET IDX=$ORDER(REJS(IDX))
IF 'IDX
QUIT
Begin DoDot:1
+52 KILL ARRAY
DO GETS^DIQ(52.25,IDX_","_RX_",","*","","ARRAY")
+53 KILL REJFLD
MERGE REJFLD=ARRAY(52.25,IDX_","_RX_",")
+54 IF $GET(CODE)
IF REJFLD(.01)'=CODE
QUIT
+55 SET REJDATA(IDX,"CODE")=$GET(REJFLD(.01))
+56 SET REJDATA(IDX,"DATE/TIME")=$GET(REJFLD(1))
+57 SET REJDATA(IDX,"PAYER MESSAGE")=$GET(REJFLD(2))
+58 SET REJDATA(IDX,"REASON")=$GET(REJFLD(3))
+59 SET REJDATA(IDX,"PHARMACIST")=$GET(REJFLD(4))
+60 SET REJDATA(IDX,"INSURANCE NAME")=$GET(REJFLD(20))
+61 SET REJDATA(IDX,"GROUP NAME")=$GET(REJFLD(6))
+62 SET REJDATA(IDX,"GROUP NUMBER")=$GET(REJFLD(21))
+63 SET REJDATA(IDX,"CARDHOLDER ID")=$GET(REJFLD(22))
+64 SET REJDATA(IDX,"PLAN CONTACT")=$GET(REJFLD(7))
+65 SET REJDATA(IDX,"PLAN PREVIOUS FILL DATE")=$GET(REJFLD(8))
+66 SET REJDATA(IDX,"STATUS")=$GET(REJFLD(9))
+67 SET REJDATA(IDX,"OTHER REJECTS")=$GET(REJFLD(17))
+68 SET REJDATA(IDX,"DUR TEXT")=$GET(REJFLD(18))
+69 SET REJDATA(IDX,"REASON SVC CODE")=$GET(REJFLD(14))
+70 SET REJDATA(IDX,"RESPONSE IEN")=$GET(REJFLD(16))
+71 IF '$GET(OKCL)
QUIT
+72 SET REJDATA(IDX,"CLOSED DATE/TIME")=$GET(REJFLD(10))
+73 SET REJDATA(IDX,"CLOSED BY")=$GET(REJFLD(11))
+74 SET REJDATA(IDX,"CLOSE REASON")=$GET(REJFLD(12))
+75 SET REJDATA(IDX,"CLOSE COMMENTS")=$GET(REJFLD(13))
+76 SET REJDATA(IDX,"COD1")=$GET(REJFLD(14))
+77 SET REJDATA(IDX,"COD2")=$GET(REJFLD(15))
+78 SET REJDATA(IDX,"COD3")=$GET(REJFLD(19))
+79 SET REJDATA(IDX,"CLA CODE")=$GET(REJFLD(24))
+80 SET REJDATA(IDX,"PRIOR AUTH TYPE")=$GET(REJFLD(25))
+81 SET REJDATA(IDX,"PRIOR AUTH NUMBER")=$GET(REJFLD(26))
+82 SET COM=0
FOR
SET COM=$ORDER(^PSRX(RX,"REJ",IDX,"COM",COM))
IF 'COM
QUIT
Begin DoDot:2
+83 SET Z=^PSRX(RX,"REJ",IDX,"COM",COM,0)
+84 SET REJDATA(IDX,"COMMENTS",COM,"DATE/TIME")=$PIECE(Z,"^")
+85 SET REJDATA(IDX,"COMMENTS",COM,"USER")=$PIECE(Z,"^",2)
+86 SET REJDATA(IDX,"COMMENTS",COM,"COMMENTS")=$PIECE(Z,"^",3)
End DoDot:2
End DoDot:1
+87 QUIT
+88 ;
HELP(OPTS) ; Display the Help Text for the DUR handling options (OVERRIDE/IGNORE/STOP/QUIT)
+1 ;
+2 IF OPTS["O"
Begin DoDot:1
+3 WRITE !?1,"(O)verride - This option will provide the prompts for the code sets needed to"
+4 WRITE !?1," override this reject and get a payable 3rd party claim. Before"
+5 WRITE !?1," you select this option, you may need to call the 3rd party payer"
+6 WRITE !?1," to determine which code sets are needed to override a particular"
+7 WRITE !?1," reject. Once the proper override is accepted the label will print"
+8 WRITE !?1," and the prescription can be filled."
End DoDot:1
+9 ;
+10 IF OPTS["I"
Begin DoDot:1
+11 WRITE !?1,"(I)gnore - Choosing Ignore will by-pass 3rd party processing and will allow"
+12 WRITE !?1," you to print a label and fill the prescription. This essentially"
+13 WRITE !?1," ignores the clinical safety issues suggested by the 3rd party"
+14 WRITE !?1," payer and will NOT result in a payable claim."
End DoDot:1
+15 ;
+16 IF OPTS["Q"
Begin DoDot:1
+17 WRITE !?1,"(Q)uit - Choosing Quit will postpone the processing of this prescription"
+18 WRITE !?1," until this 3rd party reject is resolved. A label will not be"
+19 WRITE !?1," printed for this prescription and it can not be filled/dispensed"
+20 WRITE !?1," until this reject is resolved. Rejects can be resolved through"
+21 WRITE !?1," the Worklist option under the ePharmacy menu."
End DoDot:1
+22 QUIT
+23 ;
DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
+4 NEW TXT,DVINFO,NCPNPI
+5 SET DVINFO="Division : "_$$GET1^DIQ(59,+$$RXSITE^PSOBPSUT(RX,RFL),.01)
+6 SET NCPNPI=$PIECE($$NABP^BPSBUTL(RX,RFL)," ")
+7 SET $EXTRACT(DVINFO,$SELECT($GET(LM):58,1:51))=$SELECT($LENGTH(NCPNPI)=7:"NCPDP",1:" NPI")_"#: "_NCPNPI
+8 QUIT DVINFO
+9 ;
PTINFO(RX,LM) ; Returns header displayable Patient Information
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
+3 NEW DFN,VADM,PTINFO
+4 SET DFN=$$GET1^DIQ(52,RX,2,"I")
DO DEM^VADPT
+5 SET PTINFO="Patient : "_$EXTRACT($GET(VADM(1)),1,$SELECT($GET(LM):24,1:20))_"("_$PIECE($GET(VADM(2)),"^",2)_")"
+6 SET PTINFO=PTINFO_" Sex: "_$PIECE($GET(VADM(5)),"^")
+7 SET $EXTRACT(PTINFO,$SELECT($GET(LM):61,1:54))="DOB: "_$PIECE($GET(VADM(3)),"^",2)_"("_$PIECE($GET(VADM(4)),"^")_")"
+8 QUIT PTINFO
+9 ;
RETRXF(RX,RFL,ONOFF) ; - Set/Reset the Re-transmission flag
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (r) RFL - Refill IEN (#52.1)
+3 ; (o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF)
+4 NEW DA,DIE,DR
+5 SET DR="82///"_$SELECT($GET(ONOFF):"YES",1:"@")
+6 IF 'RFL
SET DA=RX
SET DIE="^PSRX("
+7 IF RFL
SET DA(1)=RX
SET DA=RFL
SET DIE="^PSRX("_RX_",1,"
+8 DO ^DIE
+9 QUIT
+10 ;
REASON(TXT) ; Extracts the Reason for service code from the REASON text field
+1 ; Input: (r) TXT - Reason text (e.g., NN Reason for Service Code Text)
+2 ;Output: REASON - NN (if on valid and on file (#9002313.23), null otherwise)
+3 NEW REASON,DIC,X,Y
+4 SET REASON=$PIECE(TXT," ")
IF $LENGTH(REASON)'=2
QUIT ""
+5 SET DIC=9002313.23
SET X=REASON
DO ^DIC
IF Y<0
QUIT ""
+6 QUIT REASON
+7 ;
SETOPN(RX,REJ) ; - Set the Reject RE-OPENED flag to YES
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (r) REJ - Reject IEN (#52.25)
+3 ;
+4 IF '$DATA(^PSRX(RX,"REJ",REJ))
QUIT
+5 NEW DIE,DA,DR
+6 SET DIE="^PSRX("_RX_",""REJ"","
SET DA(1)=RX
SET DA=REJ
SET DR="23///YES"
DO ^DIE
+7 QUIT
+8 ;
PRT(FIELD,P,L) ; Sets the lines for fields that require text wrapping
+1 ;Input: FIELD - Subscript name from the DATA(REJ,FIELD) array
+2 ; P - Position where the content should be printed
+3 ; L - Lenght of the text on each line
+4 NEW TXT,I
+5 SET TXT=DATA(REJ,FIELD)
IF $LENGTH(TXT)'>L
WRITE ?P,TXT
QUIT
+6 FOR I=1:1
IF TXT=""
QUIT
Begin DoDot:1
+7 IF I=1
WRITE ?P,$EXTRACT(TXT,1,L),!
SET TXT=$EXTRACT(TXT,L+1,999)
QUIT
+8 WRITE ?P,$EXTRACT(TXT,1,L)
SET TXT=$EXTRACT(TXT,L+1,999)
IF TXT'=""
WRITE !
End DoDot:1
+9 QUIT
+10 ;
PA() ; - Ask for Prior Authorization Type and Number
+1 ;Output:(PAT^PAN) PAT - Prior Authorization Type (See DD File#52,
+2 ; Sub-file#52.25,field#25 for possible values)
+3 ; PAN - Prior Authorization Number (11 digits)
+4 ;
+5 NEW DIR,Y,DIRUT,DIROUT,PAT,PAN
+6 SET DIR(0)="52.25,25"
SET DIR("A")=" Prior Authorization Type"
SET DIR("B")="0"
+7 SET (DIR("?"),DIR("??"))="^D PAHLP^PSOREJU2"
+8 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT "^"
+9 SET PAT=Y
+10 KILL DIR
SET DIR(0)="52.25,26"
SET DIR("A")="Prior Authorization Number"
+11 SET DIR("?")="^D PANHLP^PSOREJU2"
SET DIR("??")=""
+12 DO ^DIR
IF (Y["^")!$DATA(DIROUT)
QUIT "^"
+13 SET PAN=Y
+14 QUIT (PAT_"^"_PAN)
+15 ;
PAHLP ; Prior Authorization Type Help
+1 WRITE !?9,"EPSDT - Early Periodic Screening Diagnosis Treatment"
+2 WRITE !?9,"AFDC - Aid to Family with Dependent Children"
+3 QUIT
+4 ;
PANHLP ; Prior Authorization Number Help
+1 WRITE "OR you may leave it blank if the claim does not require a number."
+2 QUIT
