BPSVRX3 ;AITC/PD - Print Report from VER;5/2/2017
;;1.0;E CLAIMS MGMT ENGINE;**22,23**;JUN 2004;Build 44
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to MEDPRO^PSOPMP0 supported by IA #6863
;
Q
;
REPORT ; Select and print sections of the list.
;
; Allow the user to select one or more sections of the VER list to
; print to the specified device.
;
N BPSAR,BPSLIST
D FULL^VALM1
;
LIST I '$$SELECT(.BPSLIST) G REXIT
;
D BUILD
;
I '$$DEVICE() G REXIT:$$STOP,LIST
;
REXIT ; Exit point.
;
Q
;
SELECT(BPSLIST) ; Allow user to select sections of the list to be printed.
;
; This function returns a 1 if the user entered one or more sections
; to be printed, 0 if no selection was made.
; This function expects the following variables to exist:
; - BPSVRX("LISTNAV",Section#) = Beginning Line#
; where Section# is a number, 1-14, corresponding to a section of the
; ListMan list, and Beginning Line# is the first line of that section.
;
; Returns the BPSLIST array with a list of one or more sections:
; BPSLIST(Section#) = First Line ^ Last Line
; Where First Line and Last Line are the first and last lines of
; that section in the list and Section# can be one or more numbers
; from 1 to 14, each corresponding to a section:
; 10 - AP, TPJI Account Profile
; 3 - BE, Billing Events
; 9 - CI, TPJI Claim Info
; 2 - CL, Claim Log
; 11 - CM, TPJI AR Comment History
; 5 - CR, Claims Response Inquiry Report
; 12 - ER, TPJI ECME Rx Information
; 13 - ES, Eligibility Status
; 14 - EV, Eligibility Verification
; 6 - IN, Insurance
; 7 - LB, List of Bills
; 8 - MP, Medication Profile
; Comment out SD until US1401 is coded
; 4 - SD, Sensitive Drug
; 1 - VW, View Rx
;
N BPSLC,BPSLISTNAV,BPSSECBEGIN,BPSSECEND,BPSSECNUM,BPSSECLIST,BPSSEL
N BPSUC,BPSX,BPSY,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
; Comment out SD until US1401 is coded
; S BPSSECLIST=",AP,BE,CI,CL,CM,CR,ER,ES,EV,IN,LB,MP,SD,VW,"
S BPSSECLIST=",AP,BE,CI,CL,CM,CR,ER,ES,EV,IN,LB,MP,VW,"
S BPSLISTNAV("AP")=10
S BPSLISTNAV("BE")=3
S BPSLISTNAV("CI")=9
S BPSLISTNAV("CL")=2
S BPSLISTNAV("CM")=11
S BPSLISTNAV("CR")=5
S BPSLISTNAV("ER")=12
S BPSLISTNAV("ES")=13
S BPSLISTNAV("EV")=14
S BPSLISTNAV("IN")=6
S BPSLISTNAV("LB")=7
S BPSLISTNAV("MP")=8
; Comment out SD until US1401 is coded
; S BPSLISTNAV("SD")=4
S BPSLISTNAV("VW")=1
;
S BPSUC="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S BPSLC="abcdefghijklmnopqrstuvwxyz"
;
; Display the list of actions to the user once, upon executing the PR option.
; List can be re-displayed to the user by entering ??.
W !
W !,"VW View Rx CR CRI Report CI TPJI Claim Info ER TPJI ECME Rx"
W !,"CL Claim Log IN Insurance AP TPJI Acct Pro ES Elig Status"
W !,"BE Billing Events LB List of Bills CM TPJI AR Comm EV Elig Verif"
; Comment out SD until US1401 is coded
; W !,"SD Sensitive Drug MP Med Profile"
W !," MP Med Profile"
W !
;
SELECT1 ; Prompt user for section(s) to print.
;
S DIR(0)="FOU^0:80"
S DIR("A")="Select Report to Print"
S DIR("?",1)=" Select one or many report(s) to print, separated by commas. When all"
S DIR("?",2)=" reports have been selected, hit enter without making another selection."
S DIR("?",3)=" Example: "
S DIR("?",4)=" Select Report to Print: VW,IN,CM"
S DIR("?")=" Select Report to Print: ES"
S DIR("??")="^D HELP^BPSVRX3"
;
D ^DIR
;
; If user enters "^" or "^^", or it times out, clear out the
; list and skip to end.
;
I $D(DTOUT)!$D(DUOUT) K BPSLIST G SELECTQ
;
; If user entered nothing, skip to end.
;
I X="" G SELECTQ
;
; Convert any lower case to upper case
S X=$TR(X,BPSLC,BPSUC)
;
F BPSX=1:1:$L(X,",") D
. S BPSSEL=$P(X,",",BPSX)
. I BPSSECLIST'[(","_BPSSEL_",") W !,*7," ",BPSSEL," is not a valid entry." Q
. S BPSSECNUM=BPSLISTNAV(BPSSEL)
. I $D(BPSLIST(BPSSECNUM)) W !,*7," ",BPSSEL," already selected." Q
. S BPSSECBEGIN=$G(BPSVRX("LISTNAV",BPSSECNUM))
. S BPSY=$O(BPSVRX("LISTNAV",BPSSECNUM))
. I BPSY'="" S BPSSECEND=$G(BPSVRX("LISTNAV",BPSY))-1
. E S BPSSECEND=$O(^TMP("BPSVRX",$J,""),-1)
. S BPSLIST(BPSSECNUM)=BPSSECBEGIN_"^"_BPSSECEND
. Q
;
G SELECT1
;
SELECTQ ;
I '$D(BPSLIST) Q 0
Q 1
;
BUILD ; Move selected compiled data into BPSAR array
;
N BPSBEGIN,BPSEND,BPSLINE,BPSSECTION
;
K BPSAR
S BPSSECTION=""
F S BPSSECTION=$O(BPSLIST(BPSSECTION)) Q:BPSSECTION="" D
. S BPSBEGIN=$P(BPSLIST(BPSSECTION),U,1)
. S BPSEND=$P(BPSLIST(BPSSECTION),U,2)
. ;
. S BPSLINE=BPSBEGIN-1
. F S BPSLINE=$O(^TMP("BPSVRX",$J,BPSLINE)) Q:'BPSLINE Q:BPSLINE>BPSEND D
. . ;
. . S BPSAR(BPSLINE)=^TMP("BPSVRX",$J,BPSLINE,0)
Q
;
DEVICE() ; Prompt user for output device.
; Function return values:
; 1 - User selected a device.
; 0 - User exited out.
;
N BPSRETURN,DIR,POP,X,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
S BPSRETURN=1
;
S ZTRTN="PRINT^BPSVRX3"
S ZTDESC="VER View Prescription Report"
S ZTSAVE("BPS*")=""
S ZTSAVE("VALMHDR(")=""
;
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
I POP S BPSRETURN=0
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR
;
Q BPSRETURN
;
STOP() ; Determine if user wishes to exit out of the option entirely.
; Function return values:
; 1 - Yes, exit entirely.
; 0 - No, do not exit but return to the previous question.
;
N DIR,DIRUT,Y
;
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
W !
D ^DIR
I $D(DIRUT) S Y=1
Q Y
;
PRINT ; Print sections of the list.
;
; BPSLIST will be an array of one or more sections from the existing
; ListMan list stored in ^TMP("BPSVRX",$J). Format of BPSLIST:
; BPSLIST(Section#) = First Line ^ Last Line
; Where First Line and Last Line are the first and last lines of
; that section in the list and Section# can be one or more numbers
; from 1 to 14, each corresponding to a section:
; 10 - AP, TPJI Account Profile
; 3 - BE, Billing Events
; 9 - CI, TPJI Claim Info
; 2 - CL, Claim Log
; 11 - CM, TPJI AR Comment History
; 5 - CR, Claims Response Inquiry Report
; 12 - ER, TPJI ECME Rx Information
; 13 - ES, Eligibility Status
; 14 - EV, Eligibility Verification
; 6 - IN, Insurance
; 7 - LB, List of Bills
; 8 - MP, Medication Profile
; Comment out SD until US1401 is coded
; 4 - SD, Sensitive Drug
; 1 - VW, View Rx
;
N BPSCRT,BPSBEGIN,BPSDASHES,BPSEND,BPSLINE,BPSPAGE,BPSSECTION,BPSSTOP
;
S BPSCRT=$S($E(IOST,1,2)="C-":1,1:0)
S BPSPAGE=0,BPSSTOP=0,$P(BPSDASHES,"=",79)=""
;
S BPSSECTION=""
F S BPSSECTION=$O(BPSLIST(BPSSECTION)) Q:BPSSECTION="" D Q:BPSSTOP
. S BPSBEGIN=$P(BPSLIST(BPSSECTION),U,1)
. S BPSEND=$P(BPSLIST(BPSSECTION),U,2)
. ;
. ; Display the header at the top of each section.
. ;
. D HEADER
. ;
. S BPSLINE=BPSBEGIN-1
. F S BPSLINE=$O(BPSAR(BPSLINE)) Q:'BPSLINE Q:BPSLINE>BPSEND D Q:BPSSTOP
. . ;
. . I $Y+3>IOSL D HEADER I BPSSTOP Q
. . ;
. . W !,BPSAR(BPSLINE)
. . ;
. . Q
. Q
;
I BPSSTOP G PRINTQ
I $Y+4>IOSL D HEADER I BPSSTOP G PRINTQ
W !!?5,"*** End of Report ***"
I BPSCRT S DIR(0)="E" W ! D ^DIR K DIR
;
PRINTQ ;
;
I $D(ZTQUEUED) S ZTREQ="@" ; If queued, purge the task after exiting.
;
Q
;
;
N BPSX
;
; If PAGE (i.e. not the first page) and device is the screen, do an
; end-of-page reader call. If PAGE or screen output, do a form feed.
; If this is the first page ('BPSPAGE), and device is file or printer
; ('BPSCRT), reset the left margin ($C(13)).
;
I BPSPAGE,BPSCRT S DIR(0)="E" D ^DIR K DIR I 'Y S BPSSTOP=1 G HEADERQ
I BPSPAGE!BPSCRT W @IOF
I 'BPSPAGE,'BPSCRT W $C(13)
S BPSPAGE=BPSPAGE+1
;
; Write the report header.
;
W "View Pharmacy Rx Report",?70,"Page: ",BPSPAGE,!
;
S BPSX=0
F S BPSX=$O(VALMHDR(BPSX)) Q:'BPSX W VALMHDR(BPSX),!
W BPSDASHES
;
Q
;
HELP ; ?? Help - Display Options
W !,"VW View Rx CR CRI Report CI TPJI Claim Info ER TPJI ECME Rx"
W !,"CL Claim Log IN Insurance AP TPJI Acct Pro ES Elig Status"
W !,"BE Billing Events LB List of Bills CM TPJI AR Comm EV Elig Verif"
; Comment out SD until US1401 is coded
; W !,"SD Sensitive Drug MP Med Profile"
W !," MP Med Profile"
W !
W !," Select one or many report(s) to print, separated by commas. When all"
W !," reports have been selected, hit enter without making another selection."
W !," Example: "
W !," Select Report to Print: VW,IN,CM"
W !," Select Report to Print: ES"
Q
;
SD(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; SD Sensitive Drug
;
I '$D(ZTQUEUED) W !,"Compiling data for Sensitive Drug ..."
;
N BPSCNT,BPSDRUG,BPSDRUGNAME,BPSINS,BPSINSNAME,BPSSD
N BPSSDEFF,BPSSDEXP,BPSSDSTRING,DFN
;
K ^TMP("BPSVRX-SD",$J)
;
; Determine Patient, DFN
;
S DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I") ; Patient IEN.
;
; Call IB API to pull ROI/SD information for this patient.
;
D BLD^IBNCPDR
;
S ^TMP("BPSVRX-SD",$J,1,0)=""
S ^TMP("BPSVRX-SD",$J,2,0)=" S Drug Insurance ROI Eff Dt-Exp Dt"
S ^TMP("BPSVRX-SD",$J,3,0)=" Non-Sensitive Diagnosis Authorizer Auth Dt"
S ^TMP("BPSVRX-SD",$J,4,0)="----------------------------------------------------------------------------"
S BPSCNT=4
;
S BPSLINE=0
F S BPSLINE=$O(^TMP("IBNCR",$J,BPSLINE)) Q:'BPSLINE D
. S BPSCNT=BPSCNT+1
. S ^TMP("BPSVRX-SD",$J,BPSCNT,0)=^TMP("IBNCR",$J,BPSLINE,0)
;
;
I BPSCNT=3 D
. S ^TMP("BPSVRX-SD",$J,4,0)=""
. S ^TMP("BPSVRX-SD",$J,5,0)=" -- No SD's on file for patient --"
. S BPSCNT=5
S ^TMP("BPSVRX-SD",$J,BPSCNT+1,0)=""
;
D UPDATE^BPSVRX($NA(^TMP("BPSVRX-SD",$J)),"","","Sensitive Drug",BPSSNUM)
;
K ^TMP("BPSVRX-SD",$J)
;
Q
;
MP(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; MP Medication Profile
;
;
I '$D(ZTQUEUED) W !,"Compiling data for Medication Profile ..."
;
N ALLERGY,BPSCNT,BPSLINE,DFN,DOB,GMRVSTR,HT,HTDT,LINE1
N LINE2,LINE3,LINE4,PSONOAL,SEX,SITE,WT,WTDT,X
;
K ^TMP("BPSVRX-MP",$J)
;
; Call PSO API to pull MP information for this patient.
;
D MEDPRO^PSOPMP0(RXIEN,FILL) ; ICR# 6863
;
S SITE=+$$RXSITE^PSOBPSUT(RXIEN,FILL)
S DFN=+$$GET1^DIQ(52,RXIEN,2,"I")
D LOAD^PSOPMPPF(SITE,DUZ)
D DEM^VADPT
S PNAME=VADM(1)
S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN")
S SEX=$P(VADM(5),"^",2)
S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)
S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)
S LINE1=PNAME
S (PSONOAL,ALLERGY)=""
D EN1^GMRADPT
I GMRAL S ALLERGY="<A>"
E D ALLERGY^PSOORUT2 I PSONOAL'="" S ALLERGY="<NO ALLERGY ASSESSMENT>"
S LINE1=LINE1,$E(LINE1,43)=ALLERGY
S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")
S LINE3=" DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")
S LINE4=" SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"
;
S ^TMP("BPSVRX-MP",$J,1,0)=LINE1
S ^TMP("BPSVRX-MP",$J,2,0)=LINE2
S ^TMP("BPSVRX-MP",$J,3,0)=LINE3
S ^TMP("BPSVRX-MP",$J,4,0)=LINE4
S ^TMP("BPSVRX-MP",$J,5,0)=""
S ^TMP("BPSVRX-MP",$J,6,0)=" ISSUE LAST REF DAY"
S ^TMP("BPSVRX-MP",$J,7,0)=" # Rx# DRUG [^] QTY ST DATE FILL REM SUP"
S ^TMP("BPSVRX-MP",$J,8,0)="--------------------------------------------------------------------------------"
S BPSCNT=8
;
S BPSLINE=0
F S BPSLINE=$O(^TMP("PSOPMP0",$J,BPSLINE)) Q:'BPSLINE D
. S BPSCNT=BPSCNT+1
. S ^TMP("BPSVRX-MP",$J,BPSCNT,0)=^TMP("PSOPMP0",$J,BPSLINE,0)
;
I BPSCNT=8 D
. S ^TMP("BPSVRX-MP",$J,1,0)=""
. S ^TMP("BPSVRX-MP",$J,2,0)=" -- No prescriptions found for this patient --"
. S BPSCNT=2
S ^TMP("BPSVRX-MP",$J,BPSCNT+1,0)=""
;
D UPDATE^BPSVRX($NA(^TMP("BPSVRX-MP",$J)),"","","Medication Profile",BPSSNUM)
;
K ^TMP("BPSVRX-MP",$J),^TMP("PSOPMP0",$J)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSVRX3 12672 printed Sep 02, 2024@18:39:02 Page 2
BPSVRX3 ;AITC/PD - Print Report from VER;5/2/2017
+1 ;;1.0;E CLAIMS MGMT ENGINE;**22,23**;JUN 2004;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to MEDPRO^PSOPMP0 supported by IA #6863
+5 ;
+6 QUIT
+7 ;
REPORT ; Select and print sections of the list.
+1 ;
+2 ; Allow the user to select one or more sections of the VER list to
+3 ; print to the specified device.
+4 ;
+5 NEW BPSAR,BPSLIST
+6 DO FULL^VALM1
+7 ;
LIST IF '$$SELECT(.BPSLIST)
GOTO REXIT
+1 ;
+2 DO BUILD
+3 ;
+4 IF '$$DEVICE()
if $$STOP
GOTO REXIT
GOTO LIST
+5 ;
REXIT ; Exit point.
+1 ;
+2 QUIT
+3 ;
SELECT(BPSLIST) ; Allow user to select sections of the list to be printed.
+1 ;
+2 ; This function returns a 1 if the user entered one or more sections
+3 ; to be printed, 0 if no selection was made.
+4 ; This function expects the following variables to exist:
+5 ; - BPSVRX("LISTNAV",Section#) = Beginning Line#
+6 ; where Section# is a number, 1-14, corresponding to a section of the
+7 ; ListMan list, and Beginning Line# is the first line of that section.
+8 ;
+9 ; Returns the BPSLIST array with a list of one or more sections:
+10 ; BPSLIST(Section#) = First Line ^ Last Line
+11 ; Where First Line and Last Line are the first and last lines of
+12 ; that section in the list and Section# can be one or more numbers
+13 ; from 1 to 14, each corresponding to a section:
+14 ; 10 - AP, TPJI Account Profile
+15 ; 3 - BE, Billing Events
+16 ; 9 - CI, TPJI Claim Info
+17 ; 2 - CL, Claim Log
+18 ; 11 - CM, TPJI AR Comment History
+19 ; 5 - CR, Claims Response Inquiry Report
+20 ; 12 - ER, TPJI ECME Rx Information
+21 ; 13 - ES, Eligibility Status
+22 ; 14 - EV, Eligibility Verification
+23 ; 6 - IN, Insurance
+24 ; 7 - LB, List of Bills
+25 ; 8 - MP, Medication Profile
+26 ; Comment out SD until US1401 is coded
+27 ; 4 - SD, Sensitive Drug
+28 ; 1 - VW, View Rx
+29 ;
+30 NEW BPSLC,BPSLISTNAV,BPSSECBEGIN,BPSSECEND,BPSSECNUM,BPSSECLIST,BPSSEL
+31 NEW BPSUC,BPSX,BPSY,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+32 ;
+33 ; Comment out SD until US1401 is coded
+34 ; S BPSSECLIST=",AP,BE,CI,CL,CM,CR,ER,ES,EV,IN,LB,MP,SD,VW,"
+35 SET BPSSECLIST=",AP,BE,CI,CL,CM,CR,ER,ES,EV,IN,LB,MP,VW,"
+36 SET BPSLISTNAV("AP")=10
+37 SET BPSLISTNAV("BE")=3
+38 SET BPSLISTNAV("CI")=9
+39 SET BPSLISTNAV("CL")=2
+40 SET BPSLISTNAV("CM")=11
+41 SET BPSLISTNAV("CR")=5
+42 SET BPSLISTNAV("ER")=12
+43 SET BPSLISTNAV("ES")=13
+44 SET BPSLISTNAV("EV")=14
+45 SET BPSLISTNAV("IN")=6
+46 SET BPSLISTNAV("LB")=7
+47 SET BPSLISTNAV("MP")=8
+48 ; Comment out SD until US1401 is coded
+49 ; S BPSLISTNAV("SD")=4
+50 SET BPSLISTNAV("VW")=1
+51 ;
+52 SET BPSUC="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+53 SET BPSLC="abcdefghijklmnopqrstuvwxyz"
+54 ;
+55 ; Display the list of actions to the user once, upon executing the PR option.
+56 ; List can be re-displayed to the user by entering ??.
+57 WRITE !
+58 WRITE !,"VW View Rx CR CRI Report CI TPJI Claim Info ER TPJI ECME Rx"
+59 WRITE !,"CL Claim Log IN Insurance AP TPJI Acct Pro ES Elig Status"
+60 WRITE !,"BE Billing Events LB List of Bills CM TPJI AR Comm EV Elig Verif"
+61 ; Comment out SD until US1401 is coded
+62 ; W !,"SD Sensitive Drug MP Med Profile"
+63 WRITE !," MP Med Profile"
+64 WRITE !
+65 ;
SELECT1 ; Prompt user for section(s) to print.
+1 ;
+2 SET DIR(0)="FOU^0:80"
+3 SET DIR("A")="Select Report to Print"
+4 SET DIR("?",1)=" Select one or many report(s) to print, separated by commas. When all"
+5 SET DIR("?",2)=" reports have been selected, hit enter without making another selection."
+6 SET DIR("?",3)=" Example: "
+7 SET DIR("?",4)=" Select Report to Print: VW,IN,CM"
+8 SET DIR("?")=" Select Report to Print: ES"
+9 SET DIR("??")="^D HELP^BPSVRX3"
+10 ;
+11 DO ^DIR
+12 ;
+13 ; If user enters "^" or "^^", or it times out, clear out the
+14 ; list and skip to end.
+15 ;
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL BPSLIST
GOTO SELECTQ
+17 ;
+18 ; If user entered nothing, skip to end.
+19 ;
+20 IF X=""
GOTO SELECTQ
+21 ;
+22 ; Convert any lower case to upper case
+23 SET X=$TRANSLATE(X,BPSLC,BPSUC)
+24 ;
+25 FOR BPSX=1:1:$LENGTH(X,",")
Begin DoDot:1
+26 SET BPSSEL=$PIECE(X,",",BPSX)
+27 IF BPSSECLIST'[(","_BPSSEL_",")
WRITE !,*7," ",BPSSEL," is not a valid entry."
QUIT
+28 SET BPSSECNUM=BPSLISTNAV(BPSSEL)
+29 IF $DATA(BPSLIST(BPSSECNUM))
WRITE !,*7," ",BPSSEL," already selected."
QUIT
+30 SET BPSSECBEGIN=$GET(BPSVRX("LISTNAV",BPSSECNUM))
+31 SET BPSY=$ORDER(BPSVRX("LISTNAV",BPSSECNUM))
+32 IF BPSY'=""
SET BPSSECEND=$GET(BPSVRX("LISTNAV",BPSY))-1
+33 IF '$TEST
SET BPSSECEND=$ORDER(^TMP("BPSVRX",$JOB,""),-1)
+34 SET BPSLIST(BPSSECNUM)=BPSSECBEGIN_"^"_BPSSECEND
+35 QUIT
End DoDot:1
+36 ;
+37 GOTO SELECT1
+38 ;
SELECTQ ;
+1 IF '$DATA(BPSLIST)
QUIT 0
+2 QUIT 1
+3 ;
BUILD ; Move selected compiled data into BPSAR array
+1 ;
+2 NEW BPSBEGIN,BPSEND,BPSLINE,BPSSECTION
+3 ;
+4 KILL BPSAR
+5 SET BPSSECTION=""
+6 FOR
SET BPSSECTION=$ORDER(BPSLIST(BPSSECTION))
if BPSSECTION=""
QUIT
Begin DoDot:1
+7 SET BPSBEGIN=$PIECE(BPSLIST(BPSSECTION),U,1)
+8 SET BPSEND=$PIECE(BPSLIST(BPSSECTION),U,2)
+9 ;
+10 SET BPSLINE=BPSBEGIN-1
+11 FOR
SET BPSLINE=$ORDER(^TMP("BPSVRX",$JOB,BPSLINE))
if 'BPSLINE
QUIT
if BPSLINE>BPSEND
QUIT
Begin DoDot:2
+12 ;
+13 SET BPSAR(BPSLINE)=^TMP("BPSVRX",$JOB,BPSLINE,0)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
DEVICE() ; Prompt user for output device.
+1 ; Function return values:
+2 ; 1 - User selected a device.
+3 ; 0 - User exited out.
+4 ;
+5 NEW BPSRETURN,DIR,POP,X,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+6 SET BPSRETURN=1
+7 ;
+8 SET ZTRTN="PRINT^BPSVRX3"
+9 SET ZTDESC="VER View Prescription Report"
+10 SET ZTSAVE("BPS*")=""
+11 SET ZTSAVE("VALMHDR(")=""
+12 ;
+13 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+14 IF POP
SET BPSRETURN=0
+15 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
+16 ;
+17 QUIT BPSRETURN
+18 ;
STOP() ; Determine if user wishes to exit out of the option entirely.
+1 ; Function return values:
+2 ; 1 - Yes, exit entirely.
+3 ; 0 - No, do not exit but return to the previous question.
+4 ;
+5 NEW DIR,DIRUT,Y
+6 ;
+7 SET DIR(0)="Y"
+8 SET DIR("A")="Do you want to exit out of this option entirely"
+9 SET DIR("B")="YES"
+10 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+11 SET DIR("?")=" Enter NO to return to the previous question."
+12 WRITE !
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET Y=1
+15 QUIT Y
+16 ;
PRINT ; Print sections of the list.
+1 ;
+2 ; BPSLIST will be an array of one or more sections from the existing
+3 ; ListMan list stored in ^TMP("BPSVRX",$J). Format of BPSLIST:
+4 ; BPSLIST(Section#) = First Line ^ Last Line
+5 ; Where First Line and Last Line are the first and last lines of
+6 ; that section in the list and Section# can be one or more numbers
+7 ; from 1 to 14, each corresponding to a section:
+8 ; 10 - AP, TPJI Account Profile
+9 ; 3 - BE, Billing Events
+10 ; 9 - CI, TPJI Claim Info
+11 ; 2 - CL, Claim Log
+12 ; 11 - CM, TPJI AR Comment History
+13 ; 5 - CR, Claims Response Inquiry Report
+14 ; 12 - ER, TPJI ECME Rx Information
+15 ; 13 - ES, Eligibility Status
+16 ; 14 - EV, Eligibility Verification
+17 ; 6 - IN, Insurance
+18 ; 7 - LB, List of Bills
+19 ; 8 - MP, Medication Profile
+20 ; Comment out SD until US1401 is coded
+21 ; 4 - SD, Sensitive Drug
+22 ; 1 - VW, View Rx
+23 ;
+24 NEW BPSCRT,BPSBEGIN,BPSDASHES,BPSEND,BPSLINE,BPSPAGE,BPSSECTION,BPSSTOP
+25 ;
+26 SET BPSCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+27 SET BPSPAGE=0
SET BPSSTOP=0
SET $PIECE(BPSDASHES,"=",79)=""
+28 ;
+29 SET BPSSECTION=""
+30 FOR
SET BPSSECTION=$ORDER(BPSLIST(BPSSECTION))
if BPSSECTION=""
QUIT
Begin DoDot:1
+31 SET BPSBEGIN=$PIECE(BPSLIST(BPSSECTION),U,1)
+32 SET BPSEND=$PIECE(BPSLIST(BPSSECTION),U,2)
+33 ;
+34 ; Display the header at the top of each section.
+35 ;
+36 DO HEADER
+37 ;
+38 SET BPSLINE=BPSBEGIN-1
+39 FOR
SET BPSLINE=$ORDER(BPSAR(BPSLINE))
if 'BPSLINE
QUIT
if BPSLINE>BPSEND
QUIT
Begin DoDot:2
+40 ;
+41 IF $Y+3>IOSL
DO HEADER
IF BPSSTOP
QUIT
+42 ;
+43 WRITE !,BPSAR(BPSLINE)
+44 ;
+45 QUIT
End DoDot:2
if BPSSTOP
QUIT
+46 QUIT
End DoDot:1
if BPSSTOP
QUIT
+47 ;
+48 IF BPSSTOP
GOTO PRINTQ
+49 IF $Y+4>IOSL
DO HEADER
IF BPSSTOP
GOTO PRINTQ
+50 WRITE !!?5,"*** End of Report ***"
+51 IF BPSCRT
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
+52 ;
PRINTQ ;
+1 ;
+2 ; If queued, purge the task after exiting.
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 ;
+4 QUIT
+5 ;
+1 ;
+2 NEW BPSX
+3 ;
+4 ; If PAGE (i.e. not the first page) and device is the screen, do an
+5 ; end-of-page reader call. If PAGE or screen output, do a form feed.
+6 ; If this is the first page ('BPSPAGE), and device is file or printer
+7 ; ('BPSCRT), reset the left margin ($C(13)).
+8 ;
+9 IF BPSPAGE
IF BPSCRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET BPSSTOP=1
GOTO HEADERQ
+10 IF BPSPAGE!BPSCRT
WRITE @IOF
+11 IF 'BPSPAGE
IF 'BPSCRT
WRITE $CHAR(13)
+12 SET BPSPAGE=BPSPAGE+1
+13 ;
+14 ; Write the report header.
+15 ;
+16 WRITE "View Pharmacy Rx Report",?70,"Page: ",BPSPAGE,!
+17 ;
+18 SET BPSX=0
+19 FOR
SET BPSX=$ORDER(VALMHDR(BPSX))
if 'BPSX
QUIT
WRITE VALMHDR(BPSX),!
+20 WRITE BPSDASHES
+21 ;
+1 QUIT
+2 ;
HELP ; ?? Help - Display Options
+1 WRITE !,"VW View Rx CR CRI Report CI TPJI Claim Info ER TPJI ECME Rx"
+2 WRITE !,"CL Claim Log IN Insurance AP TPJI Acct Pro ES Elig Status"
+3 WRITE !,"BE Billing Events LB List of Bills CM TPJI AR Comm EV Elig Verif"
+4 ; Comment out SD until US1401 is coded
+5 ; W !,"SD Sensitive Drug MP Med Profile"
+6 WRITE !," MP Med Profile"
+7 WRITE !
+8 WRITE !," Select one or many report(s) to print, separated by commas. When all"
+9 WRITE !," reports have been selected, hit enter without making another selection."
+10 WRITE !," Example: "
+11 WRITE !," Select Report to Print: VW,IN,CM"
+12 WRITE !," Select Report to Print: ES"
+13 QUIT
+14 ;
SD(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; SD Sensitive Drug
+1 ;
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for Sensitive Drug ..."
+3 ;
+4 NEW BPSCNT,BPSDRUG,BPSDRUGNAME,BPSINS,BPSINSNAME,BPSSD
+5 NEW BPSSDEFF,BPSSDEXP,BPSSDSTRING,DFN
+6 ;
+7 KILL ^TMP("BPSVRX-SD",$JOB)
+8 ;
+9 ; Determine Patient, DFN
+10 ;
+11 ; Patient IEN.
SET DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
+12 ;
+13 ; Call IB API to pull ROI/SD information for this patient.
+14 ;
+15 DO BLD^IBNCPDR
+16 ;
+17 SET ^TMP("BPSVRX-SD",$JOB,1,0)=""
+18 SET ^TMP("BPSVRX-SD",$JOB,2,0)=" S Drug Insurance ROI Eff Dt-Exp Dt"
+19 SET ^TMP("BPSVRX-SD",$JOB,3,0)=" Non-Sensitive Diagnosis Authorizer Auth Dt"
+20 SET ^TMP("BPSVRX-SD",$JOB,4,0)="----------------------------------------------------------------------------"
+21 SET BPSCNT=4
+22 ;
+23 SET BPSLINE=0
+24 FOR
SET BPSLINE=$ORDER(^TMP("IBNCR",$JOB,BPSLINE))
if 'BPSLINE
QUIT
Begin DoDot:1
+25 SET BPSCNT=BPSCNT+1
+26 SET ^TMP("BPSVRX-SD",$JOB,BPSCNT,0)=^TMP("IBNCR",$JOB,BPSLINE,0)
End DoDot:1
+27 ;
+28 ;
+29 IF BPSCNT=3
Begin DoDot:1
+30 SET ^TMP("BPSVRX-SD",$JOB,4,0)=""
+31 SET ^TMP("BPSVRX-SD",$JOB,5,0)=" -- No SD's on file for patient --"
+32 SET BPSCNT=5
End DoDot:1
+33 SET ^TMP("BPSVRX-SD",$JOB,BPSCNT+1,0)=""
+34 ;
+35 DO UPDATE^BPSVRX($NAME(^TMP("BPSVRX-SD",$JOB)),"","","Sensitive Drug",BPSSNUM)
+36 ;
+37 KILL ^TMP("BPSVRX-SD",$JOB)
+38 ;
+39 QUIT
+40 ;
MP(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; MP Medication Profile
+1 ;
+2 ;
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for Medication Profile ..."
+4 ;
+5 NEW ALLERGY,BPSCNT,BPSLINE,DFN,DOB,GMRVSTR,HT,HTDT,LINE1
+6 NEW LINE2,LINE3,LINE4,PSONOAL,SEX,SITE,WT,WTDT,X
+7 ;
+8 KILL ^TMP("BPSVRX-MP",$JOB)
+9 ;
+10 ; Call PSO API to pull MP information for this patient.
+11 ;
+12 ; ICR# 6863
DO MEDPRO^PSOPMP0(RXIEN,FILL)
+13 ;
+14 SET SITE=+$$RXSITE^PSOBPSUT(RXIEN,FILL)
+15 SET DFN=+$$GET1^DIQ(52,RXIEN,2,"I")
+16 DO LOAD^PSOPMPPF(SITE,DUZ)
+17 DO DEM^VADPT
+18 SET PNAME=VADM(1)
+19 SET DOB=$SELECT(+VADM(3):$PIECE(VADM(3),"^",2)_" ("_$GET(VADM(4))_")",1:"UNKNOWN")
+20 SET SEX=$PIECE(VADM(5),"^",2)
+21 SET (WT,X)=""
SET GMRVSTR="WT"
DO EN6^GMRVUTL
IF X'=""
SET WT=$JUSTIFY($PIECE(X,"^",8)/2.2,6,2)
SET WTDT=$$DAT^PSOPMP1($PIECE(X,"^")\1,"/",1)
+22 SET (HT,X)=""
SET GMRVSTR="HT"
DO EN6^GMRVUTL
IF X'=""
SET HT=$JUSTIFY($PIECE(X,"^",8)*2.54,6,2)
SET HTDT=$$DAT^PSOPMP1($PIECE(X,"^")\1,"/",1)
+23 SET LINE1=PNAME
+24 SET (PSONOAL,ALLERGY)=""
+25 DO EN1^GMRADPT
+26 IF GMRAL
SET ALLERGY="<A>"
+27 IF '$TEST
DO ALLERGY^PSOORUT2
IF PSONOAL'=""
SET ALLERGY="<NO ALLERGY ASSESSMENT>"
+28 SET LINE1=LINE1
SET $EXTRACT(LINE1,43)=ALLERGY
+29 SET LINE2=" PID: "_$PIECE(VADM(2),"^",2)
SET $EXTRACT(LINE2,50)="HEIGHT(cm): "_$SELECT(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")
+30 SET LINE3=" DOB: "_DOB
SET $EXTRACT(LINE3,50)="WEIGHT(kg): "_$SELECT(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")
+31 SET LINE4=" SEX: "_SEX
SET $EXTRACT(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"
+32 ;
+33 SET ^TMP("BPSVRX-MP",$JOB,1,0)=LINE1
+34 SET ^TMP("BPSVRX-MP",$JOB,2,0)=LINE2
+35 SET ^TMP("BPSVRX-MP",$JOB,3,0)=LINE3
+36 SET ^TMP("BPSVRX-MP",$JOB,4,0)=LINE4
+37 SET ^TMP("BPSVRX-MP",$JOB,5,0)=""
+38 SET ^TMP("BPSVRX-MP",$JOB,6,0)=" ISSUE LAST REF DAY"
+39 SET ^TMP("BPSVRX-MP",$JOB,7,0)=" # Rx# DRUG [^] QTY ST DATE FILL REM SUP"
+40 SET ^TMP("BPSVRX-MP",$JOB,8,0)="--------------------------------------------------------------------------------"
+41 SET BPSCNT=8
+42 ;
+43 SET BPSLINE=0
+44 FOR
SET BPSLINE=$ORDER(^TMP("PSOPMP0",$JOB,BPSLINE))
if 'BPSLINE
QUIT
Begin DoDot:1
+45 SET BPSCNT=BPSCNT+1
+46 SET ^TMP("BPSVRX-MP",$JOB,BPSCNT,0)=^TMP("PSOPMP0",$JOB,BPSLINE,0)
End DoDot:1
+47 ;
+48 IF BPSCNT=8
Begin DoDot:1
+49 SET ^TMP("BPSVRX-MP",$JOB,1,0)=""
+50 SET ^TMP("BPSVRX-MP",$JOB,2,0)=" -- No prescriptions found for this patient --"
+51 SET BPSCNT=2
End DoDot:1
+52 SET ^TMP("BPSVRX-MP",$JOB,BPSCNT+1,0)=""
+53 ;
+54 DO UPDATE^BPSVRX($NAME(^TMP("BPSVRX-MP",$JOB)),"","","Medication Profile",BPSSNUM)
+55 ;
+56 KILL ^TMP("BPSVRX-MP",$JOB),^TMP("PSOPMP0",$JOB)
+57 ;
+58 QUIT
