Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOREJP1

PSOREJP1.m

Go to the documentation of this file. 
  1. PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05
  1.  ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281,287,289**;DEC 1997;Build 107
  1.  ;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720
  1.  ;Reference to ^PS(59.7 supported by IA 694
  1.  ;Reference to ^PSDRUG("AQ" supported by IA 3165
  1.  ;
  1. EN(RX,REJ,CHANGE) ; Entry point
  1.  ;
  1.  ; - DO NOT change the IF logic below as both of them might get executed (intentional)
  1.  N FILL,LASTLN,PSOTRIC,PSOCODE,PSOTCODE
  1.  S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
  1.  S PSOTRIC="",PSOTRIC=$$TRIC(RX,FILL,PSOTRIC),PSOCODE=$$GET1^DIQ(52.25,REJ_","_RX,.01)
  1.  S PSOTCODE=0 S:PSOCODE'=79&(PSOCODE'=88)&(PSOTRIC) PSOTCODE=1
  1.  I $$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY - RESOLVED")
  1.  I '$$CLOSED(RX,REJ)&(PSOTCODE) D EN^VALM("PSO REJECT TRICARE")
  1.  I '$$CLOSED(RX,REJ)&('PSOTCODE) D EN^VALM("PSO REJECT DISPLAY")
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1. HDR      ; - Builds the Header section
  1.  N LINE1,LINE2,X
  1.  S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1)
  1.  S VALMHDR(3)=$$RXINFO^PSOREJP3(RX,FILL,1),VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,2)
  1.  Q
  1.  ;
  1. TRIC(RX,RFL,PSOTRIC) ; - Return 1 for TRICARE or 0 (zero) for not TRICARE
  1.  S PSOTRIC="",PSOTRIC=$S(RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="T"):1,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="T":1,1:0)
  1.  Q PSOTRIC
  1.  ;
  1. INIT ; Builds the Body section
  1.  N DATA,LINE
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  S PSOTRIC="",PSOTRIC=$$TRIC(RX,RFL,PSOTRIC)
  1.  F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
  1.  K ^TMP("PSOREJP1",$J) S VALMCNT=0,LINE=0
  1.  D GET^PSOREJU2(RX,FILL,.DATA,REJ,1)
  1.  D REJ                   ; Display the REJECT Information
  1.  D OTH                   ; Display the Other Rejects Information
  1.  D COM^PSOREJP3          ; Display the Comment
  1.  D INS                   ; Display the Insurance Information
  1.  D CLS                   ; Display the Resolution Information
  1.  S VALMCNT=LINE
  1.  Q
  1.  ;
  1. REJ ; - DUR Information
  1.  N TYPE,PFLDT,TREJ,TDATA,PSOTRIC S TDATA=""
  1.  S PSOTRIC="",PSOTRIC=$$TRIC(RX,FILL,PSOTRIC)
  1.  I $G(PSOTRIC) D
  1.  . D SETLN("REJECT Information"_$S($G(PSOTRIC):" (TRICARE)",1:""),1,1)
  1.  . S TDATA=$$EXP(DATA(REJ,"CODE"))_" ("_$G(DATA(REJ,"CODE"))_") "
  1.  . D SETLN("Date/Time     : "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18)
  1.  . D SETLN("Reject(s)     : "_TDATA,,,18)
  1.  . F I=1:1 Q:'$D(TDATA(I))  D SETLN("              : "_TDATA(I),,,18)
  1.  . D SETLN("Status        : "_$G(DATA(REJ,"STATUS"))_" - "_$$STATUS^PSOBPSUT(RX,FILL),,,18)
  1.  . ;REJDATA(REJ,"OTHER REJECTS"
  1.  I '$G(PSOTRIC) D
  1.  .D SETLN("REJECT Information",1,1)
  1.  .S TYPE=$S($G(DATA(REJ,"CODE"))=79:"79 - REFILL TOO SOON",1:"")
  1.  .I TYPE="" S TYPE=DATA(REJ,"CODE")_" - "_$E($$EXP(DATA(REJ,"CODE")),1,23)_"-"
  1.  .D SETLN("Reject Type    : "_TYPE_" received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18)
  1.  .D SETLN("Reject Status  : "_$G(DATA(REJ,"STATUS")),,,18)
  1.  .D SET("PAYER MESSAGE",63)
  1.  .D SET("REASON",63)
  1.  .S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE")))
  1.  .D SET("DUR TEXT",63,$S(PFLDT="":1,1:0))
  1.  .I PFLDT'="" D SETLN("Last Fill Date : "_PFLDT_" (from payer)",,1,18)
  1.  Q
  1.  ;
  1. OTH ; - Other Rejects Information
  1.  N LST,I,RJC,J,LAST
  1.  S LST=$G(DATA(REJ,"OTHER REJECTS")) I LST="" Q
  1.  D SETLN()
  1.  D SETLN("OTHER REJECTS",1,1)
  1.  F I=1:1:$L(LST,",") S RJC=$P(LST,",",I) D
  1.  . S LAST=1 F J=(I+1):1:$L(LST,",") I $P(LST,",",J)'="" S LAST=0 Q
  1.  . I RJC'="" D SETLN(RJC_" - "_$$EXP(RJC),,$S(LAST:1,1:0),6)
  1.  Q
  1.  ;
  1. INS ; - Insurance Information
  1.  D SETLN()
  1.  D SETLN("INSURANCE Information",1,1)
  1.  D SETLN("Insurance      : "_$G(DATA(REJ,"INSURANCE NAME")),,,18)
  1.  D SETLN("Contact        : "_$G(DATA(REJ,"PLAN CONTACT")),,,18)
  1.  D SETLN("Group Name     : "_$G(DATA(REJ,"GROUP NAME")),,,18)
  1.  D SETLN("Group Number   : "_$G(DATA(REJ,"GROUP NUMBER")),,,18)
  1.  D SETLN("Cardholder ID  : "_$G(DATA(REJ,"CARDHOLDER ID")),,1,18)
  1.  Q
  1.  ;
  1. CLS ; - Resolution Information
  1.  N X
  1.  I '$$CLOSED(RX,REJ) Q
  1.  D SETLN()
  1.  D SETLN("RESOLUTION Information",1,1)
  1.  D SETLN("Resolved By    : "_$G(DATA(REJ,"CLOSED BY")),,,18)
  1.  D SETLN("Date/Time      : "_$G(DATA(REJ,"CLOSED DATE/TIME")),,,18)
  1.  I $G(DATA(REJ,"CLOSE COMMENTS"))'="" D SET("CLOSE COMMENTS",63)
  1.  I $G(DATA(REJ,"COD1"))'="" D SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$G(DATA(REJ,"COD1"))),,,18)
  1.  I $G(DATA(REJ,"COD2"))'="" D SETLN("Profes. Svc    : "_$$OVRX^PSOREJU1(2,$G(DATA(REJ,"COD2"))),,,18)
  1.  I $G(DATA(REJ,"COD3"))'="" D SETLN("Result of Svc  : "_$$OVRX^PSOREJU1(3,$G(DATA(REJ,"COD3"))),,,18)
  1.  I $G(DATA(REJ,"CLA CODE"))'="" D
  1.  . N CLAPNTR S CLAPNTR=$$GET1^DIQ(52.25,REJ_","_RX_",",24,"I")
  1.  . S X=DATA(REJ,"CLA CODE")_" - "_$$GET1^DIQ(9002313.25,CLAPNTR,".02")
  1.  . D SETLN("Clarific. Code : "_X,,,18)
  1.  I $G(DATA(REJ,"PRIOR AUTH TYPE"))'="" D
  1.  . S X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE"))
  1.  . D SETLN("Prior Auth.Type: "_X,,,18),SETLN("Prior Auth. #  : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18)
  1.  D SETLN("Reason         : "_$G(DATA(REJ,"CLOSE REASON")),,1,18)
  1.  Q
  1.  ;
  1.  ;
  1. SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping
  1.  N TXT,T
  1.  S TXT=DATA(REJ,FIELD) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q
  1.  F I=1:1 Q:TXT=""  D
  1.  . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q
  1.  . S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999)
  1.  Q
  1.  ;
  1. LABEL(FIELD) ; Sets the label for the field
  1.  I FIELD="REASON" Q "Reason         : "
  1.  I FIELD="PAYER MESSAGE" Q "Payer Message  : "
  1.  I FIELD="DUR TEXT" Q "DUR Text       : "
  1.  I FIELD="CLOSE COMMENTS" Q "Comments       : "
  1.  Q ""
  1.  ;
  1. VIEW ; - Rx View hidden action
  1.  N VALMCNT,TITLE
  1.  I $G(PSOBACK) D  Q
  1.  . S VALMSG="Not available through Backdoor!",VALMBCK="R"
  1.  S TITLE=VALM("TITLE")
  1.  ;
  1.  ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
  1.  DO
  1.  . N PSOVDA,DA,PS
  1.  . S (PSOVDA,DA)=RX,PS="REJECT"
  1.  . N RX,REJ,FILL,LINE,TITLE D DP^PSORXVW
  1.  ;
  1.  S VALMBCK="R",VALM("TITLE")=TITLE
  1.  Q
  1.  ;
  1. EDT ; - Rx Edit hidden action
  1.  N VALMCNT,TITLE
  1.  I $G(PSOBACK) D  Q
  1.  . S VALMSG="Not available through Backdoor!",VALMBCK="R"
  1.  S TITLE=VALM("TITLE")
  1.  ;
  1.  ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
  1.  DO
  1.  . N PSOSITE,ORN,PSOPAR,PSOLIST
  1.  . S PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL),ORN=RX
  1.  . S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_","
  1.  . N RX,REJ,FILL,LINE,TITLE D EPH^PSORXEDT
  1.  ;
  1.  K VALMBCK I $$CLOSED(RX,REJ),$D(PSOSTFLT),PSOSTFLT="U" S CHANGE=1 Q
  1.  S VALMBCK="R",VALM("TITLE")=TITLE
  1.  Q
  1.  ;
  1. OVR ; - Override a REJECT action
  1.  I $$CLOSED(RX,REJ,1) Q
  1.  N COD1,COD2,COD3
  1.  D FULL^VALM1 W !
  1.  S COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" S VALMBCK="R" Q
  1.  S COD2=$$OVRCOD^PSOREJU1(2) I COD2="^" S VALMBCK="R" Q
  1.  S COD3=$$OVRCOD^PSOREJU1(3) I COD3="^" S VALMBCK="R" Q
  1.  D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3)
  1.  D SEND^PSOREJP3(COD1,COD2,COD3)
  1.  Q
  1.  ;
  1. RES ; - Re-submit a claim action
  1.  I $$CLOSED(RX,REJ,1) Q
  1.  D FULL^VALM1 W !
  1.  D SEND^PSOREJP3()
  1.  Q
  1.  ;
  1. CLA ; - Submit Clarification Code
  1.  N CLA
  1.  I $$CLOSED(RX,REJ,1) Q
  1.  D FULL^VALM1 W !
  1.  S CLA=$$CLA^PSOREJU1() I CLA="^" S VALMBCK="R" Q
  1.  W ! D SEND^PSOREJP3(,,,CLA)
  1.  Q
  1.  ;
  1. PA ; - Submit Prior Authorization
  1.  N PA
  1.  I $$CLOSED(RX,REJ,1) Q
  1.  D FULL^VALM1 W !
  1.  S PA=$$PA^PSOREJU2() I PA="^" S VALMBCK="R" Q
  1.  W ! D SEND^PSOREJP3(,,,,PA)
  1.  Q
  1.  ;
  1. MP ; - Patient Medication Profile
  1.  I $G(PSOBACK) D  Q
  1.  . S VALMSG="Not available through Backdoor!",VALMBCK="R"
  1.  N SITE,PATIENT
  1.  D FULL^VALM1 W !
  1.  S SITE=+$$RXSITE^PSOBPSUT(RX,FILL) S:$G(PSOSITE) SITE=PSOSITE
  1.  S PATIENT=+$$GET1^DIQ(52,RX,2,"I")
  1.  D LST^PSOPMP0(SITE,PATIENT) S VALMBCK="R"
  1.  Q
  1.  ;
  1. EXIT ;
  1.  K ^TMP("PSOREJP1",$J)
  1.  Q
  1.  ;
  1. SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
  1.  N X
  1.  S:$G(TEXT)="" $E(TEXT,80)=""
  1.  S:$L(TEXT)>80 TEXT=$E(TEXT,1,80)
  1.  S LINE=LINE+1,^TMP("PSOREJP1",$J,LINE,0)=$G(TEXT)
  1.  ;
  1.  I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE
  1.  ;
  1.  I $G(REV) D  Q
  1.  . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM)
  1.  . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
  1.  I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
  1.  I $G(HIG) D
  1.  . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
  1.  Q
  1. HELP ;
  1.  Q
  1.  ;
  1. CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT
  1.  I $$GET1^DIQ(52.25,REJ_","_RX,10,"I") D:$G(MSG)  Q 1
  1.  . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7)
  1.  Q 0
  1.  ;
  1. REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT
  1.  Q $S($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1)
  1.  ;
  1. EXP(CODE) ; - Returns the explanation field (.02) for a reject code
  1.  ;  Input:  (r) CODE - .01 field (Code) value from file 9002313.93
  1.  ; Output: .02 field (Explanation) value from file 9002313.93
  1.  N DIC,X,Y
  1.  S DIC=9002313.93,DIC(0)="Z",X=CODE D ^DIC
  1.  Q $P($G(Y(0)),"^",2)
  1.  ;
  1. OUT(RX) ; - Supported call by outside PROTOCOLs to act on specific REJECTs
  1.  N I,RFL,DATA,REJ,PSOBACK,VALMCNT,RXN
  1.  I '$D(^XUSEC("PSORPH",DUZ)) D  Q
  1.  . S VALMSG="PSORPH key required to use the REJ action.",VALMBCK="R"
  1.  I $G(PS)="REJECT" D
  1.  . S VALMSG="REJ action is not available at this point.",VALMBCK="R"
  1.  S PSOBACK=1
  1.  S (RFL,I)=0 F I=1:1 Q:'$D(^PSRX(RX,1,I))  S RFL=I
  1.  S X=$$FIND^PSOREJUT(RX,RFL,.DATA) S REJ=$O(DATA(""))
  1.  I '$G(REJ) S VALMSG="Invalid selection!",VALMBCK="R" Q
  1.  D EN(RX,REJ) S VALMBCK="R"
  1.  Q
  1.  ;