PSOBPSSL ;ALB/EWL - ePharmacy Site Parameters Definition ;03/20/2013
;;7.0;OUTPATIENT PHARMACY;**421,427,482,512**;DEC 1997;Build 44
;
; This routine is called from PSOBPSSP from the DP - Display Site Parameters
; action item. That is the only way this routine should be entered.
;
; ICR Calls
; ICR Type Description
; ----- --------- ---------------------------
; n/a
;
; Other Calls
; ----------------
; DIV^PSOBPSSP
Q
EN ; Entry point for PSO EPHARM PARAMS LIST List Manager screen
;
; PSODIV is the IEN of the initially selected division. Set by ^PSOLSET.
; Normally not used, only used if this routine is called directly.
; PSODIVS is an array which will contain the divisions to be listed
; PSODIVS will be formatted as follows:
; The root - PSODIVS will either be a null or contain "ALL"
; PSODIVS(#) - the # is the ien in file 52.86
; PSODIVS(#) - value --> IEN^SiteName - IEN from file 52.86
;
N PSODIV,PSODIVS
;
; Launch the list manager screen
D EN^VALM("PSO EPHARM SITE PARAMS LIST")
G EXIT
;
HDR ; -- header code -- PSO EPHARM SITE PARAMS LIST
S VALMHDR(1)=$$SITES(.PSODIVS)
S VALMHDR(1)="Pharmacy Division"_$S(VALMHDR(1)[", ":"s: ",1:": ")_VALMHDR(1)
I $L(VALMHDR(1))>80 S $E(VALMHDR(1),78,999)="..."
S VALMHDR(2)="Site parameter settings for one or more Pharmacy Divisions"
Q
;
INIT ; -- init variables and list array -- PSO EPHARM SITE PARAMS LIST
; PSODIVS is an array which will contain the divisions to be listed (see EN tag)
; LINECT - keeps track of the line count in the display list
; IEN - IEN of file 52.86 (Site Parameters)
; LMARRAY - List Manager Array Name
N LMARRAY,IEN,LINECT
;
; Initialize the Line Counter
S LINECT=0
;
; Get list of sites to display
W ! D SITEPICK(.PSODIVS)
;
; Quit if no sites selected
I ('$D(PSODIVS))!($G(PSODIVS)="^") S VALMQUIT=1 Q
D CLEAN^VALM10
;
; This is the List Manager Array
S LMARRAY=$NA(^TMP("PSOBPSSL",$J)) K @LMARRAY
;
; Process if one or more but not "ALL" sites have been selected
I $G(PSODIVS)'="ALL" D
. S IEN=0 F S IEN=$O(PSODIVS(IEN)) Q:'IEN D GETDATA(IEN,LMARRAY,.LINECT)
;
; Process if "ALL" sites have been selected
I $G(PSODIVS)="ALL" D
. S IEN=0 F S IEN=$O(^PS(52.86,IEN)) Q:'IEN D GETDATA(IEN,LMARRAY,.LINECT)
S VALMCNT=LINECT
Q
HELP ; -- help code -- PSO EPHARM MULTI SITE PARAMS
S X="?" D DISP^XQORM1 W !!
Q
;
EXPND ; -- expand code
Q
;
EXIT ; -- exit code
K PSODIVS,^TMP("PSOBPSSL",$J)
Q
;
SITEPICK(DIVS) ; Get the list of sites to display
; Cloned from SEL^PSOREJU1 with changes for Site Parameter List
;
; Input Parameter
; DIVS - is passed by reference and will hold the set of divisions to process
;
; Local Variables
; QT - used to control when to exit
N QT
;
; Variables used by ^DIC
N DIC,DTOUT,DUOUT,Y,X
;
; Instructional message
W !!,"You may select a single or multiple Divisions,"
W !,"or enter ^ALL to select all Divisions.",!
;
; Select the divisions to display from 52.86
K DIVS S DIC="^PS(52.86,",DIC(0)="QEZAM"
S DIC("A")="Select a Division to display: "
F D ^DIC Q:X="" D Q:$G(QT)
. I $$UP^XLFSTR(X)="^ALL" K DIVS S DIVS="ALL",QT=1 Q
. I $G(DTOUT)!$G(DUOUT) K DIVS S DIVS="^",QT=1 Q
. W " ",$P(Y,"^",2),$S($D(DIVS(+Y)):" (already selected)",1:"")
. W ! S DIVS(+Y)="",DIC("A")="ANOTHER ONE: " K DIC("B")
Q
;
SITES(DIVS) ; - Returns the list of selected Pharmacy Divisions
N SITE,SITES,NAME,PSITE S SITES=""
; DIVS - array identifying the sites being processed.
; SITE - individual PS site numbers IN FILE 52.86
; NAME - division name from file 4
; SITES - comma delimited site names
;
; Create a string of ^ delimited division names.
I '$D(DIVS) Q ""
I $G(DIVS)="ALL" Q "ALL"
;
; Create a string of ^ delimited division names.
S SITE=0,SITES="" F S SITE=$O(DIVS(SITE)) Q:'SITE D
. S NAME=$$GET1^DIQ(52.86,SITE_",",.01,"E")
. S DIVS(SITE)=SITE_U_NAME
. S SITES=SITES_$S(SITES]"":", ",1:"")_NAME
Q SITES
;
GETDATA(IEN,DATA,NXTLINE) ; Adds and formats data from one Pharmacy Division
; This may be called multiple times when displaying multiple divisions
; This is called by PSOBPSSP
;
; INPUT PARAMETERS
; IEN - Site IEN from 52.86
; DATA - List Manager Array name
; NXTLINE - output parameter - returns line counter/number of lines in list
;
; check parameters
I '$G(IEN) Q 0 ; No parent division passed
I $L($G(DATA))<1 Q 0 ; No array passed to the routine
I '$D(NXTLINE) Q 0 ; No line number passed must be >= 0
;
; LOCAL VARIABLES
; PSOI - IEN/LOOP CONTROL while looping through array
; GETS - Temp array for GETS^DIQ results
; WLSTDAYS - Days to remain on worklist
; AUTOSEND - Auto send - yes/no
; REJEXPL - Reject code explanations text
; THRESHLD - Threshold amount for fill prevention reject codes
; GETS - array for output from LIST^DIC and processed codes
; IORVON & IORVOFF are Kernel Video Variables used for List Manager formatting
; PSOIGNORE - Ignore Threshold value
;
N PSOI,GETS,WLSTDAYS,PAUSE,CODE,AUTOSEND,REJEXPL,THRESHLD,SITE,PSOIGNORE
;
; Get the high level site parameters
S SITE=$$GET1^DIQ(52.86,IEN_",",.01)
; Site header
I NXTLINE'=0 S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=""
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)="Pharmacy Division: "_$G(SITE)
D CNTRL^VALM10(NXTLINE,1,80,IORVON,IORVOFF)
;
; Display General Parameters
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" General Parameters"
D CNTRL^VALM10(NXTLINE,3,18,IOUON,IOUOFF)
;
; Get the site worklist days
S WLSTDAYS=$$GET1^DIQ(52.86,IEN_",",4)
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" Reject Worklist Days: "_$G(WLSTDAYS)
;
; Get the ePharmacy Response Pause
S PAUSE=$$GET1^DIQ(52.86,IEN_",",6)
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" ePharmacy Response Pause: "_$G(PAUSE)
;
; Get the Ignore Threshold
S PSOIGNORE=$$GET1^DIQ(52.86,IEN_",",7)
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" Ignore Threshold: "_$G(PSOIGNORE)
;
; Process the site transfer reject codes
;
; create header for transfer reject code section
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=""
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" Transfer Reject Codes"
D CNTRL^VALM10(NXTLINE,3,21,IOUON,IOUOFF)
;
; Get the transfer reject codes
K GETS D LIST^DIC(52.8651,","_IEN_",","@;.01IE;1",,,,,,,,"GETS")
;
; create sub-header for transfer reject code section
I $D(GETS) D
. S NXTLINE=NXTLINE+1
. S @DATA@(NXTLINE,0)=" Code Description Auto-Send"
. S NXTLINE=NXTLINE+1
. S @DATA@(NXTLINE,0)=" ---- ------------------------------------------------------------ ---------"
. ;
. ; Sort the output by external code
. S PSOI=0
. F S PSOI=$O(GETS("DILIST","ID",PSOI)) Q:PSOI="" D
. . ; Parse output from LIST^DIC and add to local array GETS as follows:
. . ; GETS({external code})={external AUTO SEND}^{internal code}
. . S GETS(" "_GETS("DILIST","ID",PSOI,.01,"E"))=GETS("DILIST","ID",PSOI,1)_U_GETS("DILIST","ID",PSOI,.01,"I")
. . Q
. ; Kill the part of GETS no longer needed - from LIST^DIC
. K GETS("DILIST")
. ;
. ; process the transfer reject code body
. S PSOI="" F S PSOI=$O(GETS(PSOI)) Q:PSOI="" D
. . S CODE=PSOI,AUTOSEND=$P(GETS(PSOI),U,1)
. . ; Get reject explanation
. . S REJEXPL=$$GET1^DIQ(9002313.93,$P(GETS(PSOI),U,2)_",",.02)
. . ; Build the next list line
. . S NXTLINE=NXTLINE+1,$E(@DATA@(NXTLINE,0),3,6)=$J(CODE,4)
. . S $E(@DATA@(NXTLINE,0),9,68)=$E(REJEXPL,1,60)
. . S $E(@DATA@(NXTLINE,0),77,79)=$S(AUTOSEND="YES":"YES",1:" NO")
. Q
;
; process for no transfer reject codes
I '$D(GETS) S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" No transfer reject codes for this Pharmacy Division."
;
; Process the Reject Resolution Required Codes
;
; create header for the Reject Resolution Required Codes
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=""
S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" Reject Resolution Required Codes"
D CNTRL^VALM10(NXTLINE,3,32,IOUON,IOUOFF)
;
; Get the transfer reject codes
K GETS D LIST^DIC(52.865,","_IEN_",","@;.01IE;.02",,,,,,,,"GETS")
;
; create sub-header for the Reject Resolution Required Codes
I $D(GETS) D
. S NXTLINE=NXTLINE+1
. S @DATA@(NXTLINE,0)=" Code Description Threshold"
. S NXTLINE=NXTLINE+1
. S @DATA@(NXTLINE,0)=" ---- ------------------------------------------------------------ ---------"
. ;
. ; Sort the output by external code
. S PSOI=0
. F S PSOI=$O(GETS("DILIST","ID",PSOI)) Q:PSOI="" D
. . ; Parse output from LIST^DIC and add to local array GETS as follows:
. . ; GETS({external code})={external DOLLAR THRESHOLD}^{internal code}
. . S GETS(" "_GETS("DILIST","ID",PSOI,.01,"E"))=GETS("DILIST","ID",PSOI,.02)_U_GETS("DILIST","ID",PSOI,.01,"I")
. . Q
. ; Kill the part of GETS no longer needed - from LIST^DIC
. K GETS("DILIST")
. ;
. ; process the Reject Resolution Required code body
. S PSOI="" F S PSOI=$O(GETS(PSOI)) Q:PSOI="" D
. . S CODE=PSOI,THRESHLD=$P(GETS(PSOI),U,1)
. . ; Get reject explanation
. . S REJEXPL=$$GET1^DIQ(9002313.93,$P(GETS(PSOI),U,2)_",",.02)
. . ;
. . ; Build the next list line
. . S NXTLINE=NXTLINE+1,$E(@DATA@(NXTLINE,0),3,6)=$J(CODE,4)
. . S $E(@DATA@(NXTLINE,0),9,68)=$E(REJEXPL,1,60)
. . S THRESHLD=+THRESHLD,THRESHLD=$J("$"_$FN(THRESHLD,",",0),10)
. . S $E(@DATA@(NXTLINE,0),70,79)=THRESHLD
. Q
;
; process for no Reject Resolution Required Codes
I '$D(GETS) S NXTLINE=NXTLINE+1,@DATA@(NXTLINE,0)=" No Reject Resolution Required Codes for this Pharmacy Division."
Q
;
TRCMSG ; Transfer Reject Informational Message (called by PSOBPSSP, which was too big)
W !!,"All transfer rejects will automatically be placed on the Third Party Payer"
W !,"Rejects - Worklist if the reject code is defined in the site parameter file"
W !,"and the AUTO SEND parameter is set to yes. The OPECC must manually transfer"
W !,"the reject if the reject code is defined in the site parameter file"
W !,"and the AUTO SEND parameter is set to no. (To be used when Pharmacy can"
W !,"possibly correct a locally filled or CMOP Rx.)"
Q
;
RRRMSG ; Reject Resolution Required Informational Message (called by PSOBPSSP, which was too big)
W !!,"All Reject Resolution Required reject codes will automatically be placed"
W !,"on the Third Party Payer Rejects - Worklist. This parameter applies to"
W !,"rejects for original unreleased fills only. Prescriptions will not be filled"
W !,"until the rejects identified by the Reject Resolution parameter are resolved."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSSL 10765 printed Dec 13, 2024@02:25 Page 2
PSOBPSSL ;ALB/EWL - ePharmacy Site Parameters Definition ;03/20/2013
+1 ;;7.0;OUTPATIENT PHARMACY;**421,427,482,512**;DEC 1997;Build 44
+2 ;
+3 ; This routine is called from PSOBPSSP from the DP - Display Site Parameters
+4 ; action item. That is the only way this routine should be entered.
+5 ;
+6 ; ICR Calls
+7 ; ICR Type Description
+8 ; ----- --------- ---------------------------
+9 ; n/a
+10 ;
+11 ; Other Calls
+12 ; ----------------
+13 ; DIV^PSOBPSSP
+14 QUIT
EN ; Entry point for PSO EPHARM PARAMS LIST List Manager screen
+1 ;
+2 ; PSODIV is the IEN of the initially selected division. Set by ^PSOLSET.
+3 ; Normally not used, only used if this routine is called directly.
+4 ; PSODIVS is an array which will contain the divisions to be listed
+5 ; PSODIVS will be formatted as follows:
+6 ; The root - PSODIVS will either be a null or contain "ALL"
+7 ; PSODIVS(#) - the # is the ien in file 52.86
+8 ; PSODIVS(#) - value --> IEN^SiteName - IEN from file 52.86
+9 ;
+10 NEW PSODIV,PSODIVS
+11 ;
+12 ; Launch the list manager screen
+13 DO EN^VALM("PSO EPHARM SITE PARAMS LIST")
+14 GOTO EXIT
+15 ;
HDR ; -- header code -- PSO EPHARM SITE PARAMS LIST
+1 SET VALMHDR(1)=$$SITES(.PSODIVS)
+2 SET VALMHDR(1)="Pharmacy Division"_$SELECT(VALMHDR(1)[", ":"s: ",1:": ")_VALMHDR(1)
+3 IF $LENGTH(VALMHDR(1))>80
SET $EXTRACT(VALMHDR(1),78,999)="..."
+4 SET VALMHDR(2)="Site parameter settings for one or more Pharmacy Divisions"
+5 QUIT
+6 ;
INIT ; -- init variables and list array -- PSO EPHARM SITE PARAMS LIST
+1 ; PSODIVS is an array which will contain the divisions to be listed (see EN tag)
+2 ; LINECT - keeps track of the line count in the display list
+3 ; IEN - IEN of file 52.86 (Site Parameters)
+4 ; LMARRAY - List Manager Array Name
+5 NEW LMARRAY,IEN,LINECT
+6 ;
+7 ; Initialize the Line Counter
+8 SET LINECT=0
+9 ;
+10 ; Get list of sites to display
+11 WRITE !
DO SITEPICK(.PSODIVS)
+12 ;
+13 ; Quit if no sites selected
+14 IF ('$DATA(PSODIVS))!($GET(PSODIVS)="^")
SET VALMQUIT=1
QUIT
+15 DO CLEAN^VALM10
+16 ;
+17 ; This is the List Manager Array
+18 SET LMARRAY=$NAME(^TMP("PSOBPSSL",$JOB))
KILL @LMARRAY
+19 ;
+20 ; Process if one or more but not "ALL" sites have been selected
+21 IF $GET(PSODIVS)'="ALL"
Begin DoDot:1
+22 SET IEN=0
FOR
SET IEN=$ORDER(PSODIVS(IEN))
if 'IEN
QUIT
DO GETDATA(IEN,LMARRAY,.LINECT)
End DoDot:1
+23 ;
+24 ; Process if "ALL" sites have been selected
+25 IF $GET(PSODIVS)="ALL"
Begin DoDot:1
+26 SET IEN=0
FOR
SET IEN=$ORDER(^PS(52.86,IEN))
if 'IEN
QUIT
DO GETDATA(IEN,LMARRAY,.LINECT)
End DoDot:1
+27 SET VALMCNT=LINECT
+28 QUIT
HELP ; -- help code -- PSO EPHARM MULTI SITE PARAMS
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
EXIT ; -- exit code
+1 KILL PSODIVS,^TMP("PSOBPSSL",$JOB)
+2 QUIT
+3 ;
SITEPICK(DIVS) ; Get the list of sites to display
+1 ; Cloned from SEL^PSOREJU1 with changes for Site Parameter List
+2 ;
+3 ; Input Parameter
+4 ; DIVS - is passed by reference and will hold the set of divisions to process
+5 ;
+6 ; Local Variables
+7 ; QT - used to control when to exit
+8 NEW QT
+9 ;
+10 ; Variables used by ^DIC
+11 NEW DIC,DTOUT,DUOUT,Y,X
+12 ;
+13 ; Instructional message
+14 WRITE !!,"You may select a single or multiple Divisions,"
+15 WRITE !,"or enter ^ALL to select all Divisions.",!
+16 ;
+17 ; Select the divisions to display from 52.86
+18 KILL DIVS
SET DIC="^PS(52.86,"
SET DIC(0)="QEZAM"
+19 SET DIC("A")="Select a Division to display: "
+20 FOR
DO ^DIC
if X=""
QUIT
Begin DoDot:1
+21 IF $$UP^XLFSTR(X)="^ALL"
KILL DIVS
SET DIVS="ALL"
SET QT=1
QUIT
+22 IF $GET(DTOUT)!$GET(DUOUT)
KILL DIVS
SET DIVS="^"
SET QT=1
QUIT
+23 WRITE " ",$PIECE(Y,"^",2),$SELECT($DATA(DIVS(+Y)):" (already selected)",1:"")
+24 WRITE !
SET DIVS(+Y)=""
SET DIC("A")="ANOTHER ONE: "
KILL DIC("B")
End DoDot:1
if $GET(QT)
QUIT
+25 QUIT
+26 ;
SITES(DIVS) ; - Returns the list of selected Pharmacy Divisions
+1 NEW SITE,SITES,NAME,PSITE
SET SITES=""
+2 ; DIVS - array identifying the sites being processed.
+3 ; SITE - individual PS site numbers IN FILE 52.86
+4 ; NAME - division name from file 4
+5 ; SITES - comma delimited site names
+6 ;
+7 ; Create a string of ^ delimited division names.
+8 IF '$DATA(DIVS)
QUIT ""
+9 IF $GET(DIVS)="ALL"
QUIT "ALL"
+10 ;
+11 ; Create a string of ^ delimited division names.
+12 SET SITE=0
SET SITES=""
FOR
SET SITE=$ORDER(DIVS(SITE))
if 'SITE
QUIT
Begin DoDot:1
+13 SET NAME=$$GET1^DIQ(52.86,SITE_",",.01,"E")
+14 SET DIVS(SITE)=SITE_U_NAME
+15 SET SITES=SITES_$SELECT(SITES]"":", ",1:"")_NAME
End DoDot:1
+16 QUIT SITES
+17 ;
GETDATA(IEN,DATA,NXTLINE) ; Adds and formats data from one Pharmacy Division
+1 ; This may be called multiple times when displaying multiple divisions
+2 ; This is called by PSOBPSSP
+3 ;
+4 ; INPUT PARAMETERS
+5 ; IEN - Site IEN from 52.86
+6 ; DATA - List Manager Array name
+7 ; NXTLINE - output parameter - returns line counter/number of lines in list
+8 ;
+9 ; check parameters
+10 ; No parent division passed
IF '$GET(IEN)
QUIT 0
+11 ; No array passed to the routine
IF $LENGTH($GET(DATA))<1
QUIT 0
+12 ; No line number passed must be >= 0
IF '$DATA(NXTLINE)
QUIT 0
+13 ;
+14 ; LOCAL VARIABLES
+15 ; PSOI - IEN/LOOP CONTROL while looping through array
+16 ; GETS - Temp array for GETS^DIQ results
+17 ; WLSTDAYS - Days to remain on worklist
+18 ; AUTOSEND - Auto send - yes/no
+19 ; REJEXPL - Reject code explanations text
+20 ; THRESHLD - Threshold amount for fill prevention reject codes
+21 ; GETS - array for output from LIST^DIC and processed codes
+22 ; IORVON & IORVOFF are Kernel Video Variables used for List Manager formatting
+23 ; PSOIGNORE - Ignore Threshold value
+24 ;
+25 NEW PSOI,GETS,WLSTDAYS,PAUSE,CODE,AUTOSEND,REJEXPL,THRESHLD,SITE,PSOIGNORE
+26 ;
+27 ; Get the high level site parameters
+28 SET SITE=$$GET1^DIQ(52.86,IEN_",",.01)
+29 ; Site header
+30 IF NXTLINE'=0
SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=""
+31 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)="Pharmacy Division: "_$GET(SITE)
+32 DO CNTRL^VALM10(NXTLINE,1,80,IORVON,IORVOFF)
+33 ;
+34 ; Display General Parameters
+35 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" General Parameters"
+36 DO CNTRL^VALM10(NXTLINE,3,18,IOUON,IOUOFF)
+37 ;
+38 ; Get the site worklist days
+39 SET WLSTDAYS=$$GET1^DIQ(52.86,IEN_",",4)
+40 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" Reject Worklist Days: "_$GET(WLSTDAYS)
+41 ;
+42 ; Get the ePharmacy Response Pause
+43 SET PAUSE=$$GET1^DIQ(52.86,IEN_",",6)
+44 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" ePharmacy Response Pause: "_$GET(PAUSE)
+45 ;
+46 ; Get the Ignore Threshold
+47 SET PSOIGNORE=$$GET1^DIQ(52.86,IEN_",",7)
+48 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" Ignore Threshold: "_$GET(PSOIGNORE)
+49 ;
+50 ; Process the site transfer reject codes
+51 ;
+52 ; create header for transfer reject code section
+53 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=""
+54 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" Transfer Reject Codes"
+55 DO CNTRL^VALM10(NXTLINE,3,21,IOUON,IOUOFF)
+56 ;
+57 ; Get the transfer reject codes
+58 KILL GETS
DO LIST^DIC(52.8651,","_IEN_",","@;.01IE;1",,,,,,,,"GETS")
+59 ;
+60 ; create sub-header for transfer reject code section
+61 IF $DATA(GETS)
Begin DoDot:1
+62 SET NXTLINE=NXTLINE+1
+63 SET @DATA@(NXTLINE,0)=" Code Description Auto-Send"
+64 SET NXTLINE=NXTLINE+1
+65 SET @DATA@(NXTLINE,0)=" ---- ------------------------------------------------------------ ---------"
+66 ;
+67 ; Sort the output by external code
+68 SET PSOI=0
+69 FOR
SET PSOI=$ORDER(GETS("DILIST","ID",PSOI))
if PSOI=""
QUIT
Begin DoDot:2
+70 ; Parse output from LIST^DIC and add to local array GETS as follows:
+71 ; GETS({external code})={external AUTO SEND}^{internal code}
+72 SET GETS(" "_GETS("DILIST","ID",PSOI,.01,"E"))=GETS("DILIST","ID",PSOI,1)_U_GETS("DILIST","ID",PSOI,.01,"I")
+73 QUIT
End DoDot:2
+74 ; Kill the part of GETS no longer needed - from LIST^DIC
+75 KILL GETS("DILIST")
+76 ;
+77 ; process the transfer reject code body
+78 SET PSOI=""
FOR
SET PSOI=$ORDER(GETS(PSOI))
if PSOI=""
QUIT
Begin DoDot:2
+79 SET CODE=PSOI
SET AUTOSEND=$PIECE(GETS(PSOI),U,1)
+80 ; Get reject explanation
+81 SET REJEXPL=$$GET1^DIQ(9002313.93,$PIECE(GETS(PSOI),U,2)_",",.02)
+82 ; Build the next list line
+83 SET NXTLINE=NXTLINE+1
SET $EXTRACT(@DATA@(NXTLINE,0),3,6)=$JUSTIFY(CODE,4)
+84 SET $EXTRACT(@DATA@(NXTLINE,0),9,68)=$EXTRACT(REJEXPL,1,60)
+85 SET $EXTRACT(@DATA@(NXTLINE,0),77,79)=$SELECT(AUTOSEND="YES":"YES",1:" NO")
End DoDot:2
+86 QUIT
End DoDot:1
+87 ;
+88 ; process for no transfer reject codes
+89 IF '$DATA(GETS)
SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" No transfer reject codes for this Pharmacy Division."
+90 ;
+91 ; Process the Reject Resolution Required Codes
+92 ;
+93 ; create header for the Reject Resolution Required Codes
+94 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=""
+95 SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" Reject Resolution Required Codes"
+96 DO CNTRL^VALM10(NXTLINE,3,32,IOUON,IOUOFF)
+97 ;
+98 ; Get the transfer reject codes
+99 KILL GETS
DO LIST^DIC(52.865,","_IEN_",","@;.01IE;.02",,,,,,,,"GETS")
+100 ;
+101 ; create sub-header for the Reject Resolution Required Codes
+102 IF $DATA(GETS)
Begin DoDot:1
+103 SET NXTLINE=NXTLINE+1
+104 SET @DATA@(NXTLINE,0)=" Code Description Threshold"
+105 SET NXTLINE=NXTLINE+1
+106 SET @DATA@(NXTLINE,0)=" ---- ------------------------------------------------------------ ---------"
+107 ;
+108 ; Sort the output by external code
+109 SET PSOI=0
+110 FOR
SET PSOI=$ORDER(GETS("DILIST","ID",PSOI))
if PSOI=""
QUIT
Begin DoDot:2
+111 ; Parse output from LIST^DIC and add to local array GETS as follows:
+112 ; GETS({external code})={external DOLLAR THRESHOLD}^{internal code}
+113 SET GETS(" "_GETS("DILIST","ID",PSOI,.01,"E"))=GETS("DILIST","ID",PSOI,.02)_U_GETS("DILIST","ID",PSOI,.01,"I")
+114 QUIT
End DoDot:2
+115 ; Kill the part of GETS no longer needed - from LIST^DIC
+116 KILL GETS("DILIST")
+117 ;
+118 ; process the Reject Resolution Required code body
+119 SET PSOI=""
FOR
SET PSOI=$ORDER(GETS(PSOI))
if PSOI=""
QUIT
Begin DoDot:2
+120 SET CODE=PSOI
SET THRESHLD=$PIECE(GETS(PSOI),U,1)
+121 ; Get reject explanation
+122 SET REJEXPL=$$GET1^DIQ(9002313.93,$PIECE(GETS(PSOI),U,2)_",",.02)
+123 ;
+124 ; Build the next list line
+125 SET NXTLINE=NXTLINE+1
SET $EXTRACT(@DATA@(NXTLINE,0),3,6)=$JUSTIFY(CODE,4)
+126 SET $EXTRACT(@DATA@(NXTLINE,0),9,68)=$EXTRACT(REJEXPL,1,60)
+127 SET THRESHLD=+THRESHLD
SET THRESHLD=$JUSTIFY("$"_$FNUMBER(THRESHLD,",",0),10)
+128 SET $EXTRACT(@DATA@(NXTLINE,0),70,79)=THRESHLD
End DoDot:2
+129 QUIT
End DoDot:1
+130 ;
+131 ; process for no Reject Resolution Required Codes
+132 IF '$DATA(GETS)
SET NXTLINE=NXTLINE+1
SET @DATA@(NXTLINE,0)=" No Reject Resolution Required Codes for this Pharmacy Division."
+133 QUIT
+134 ;
TRCMSG ; Transfer Reject Informational Message (called by PSOBPSSP, which was too big)
+1 WRITE !!,"All transfer rejects will automatically be placed on the Third Party Payer"
+2 WRITE !,"Rejects - Worklist if the reject code is defined in the site parameter file"
+3 WRITE !,"and the AUTO SEND parameter is set to yes. The OPECC must manually transfer"
+4 WRITE !,"the reject if the reject code is defined in the site parameter file"
+5 WRITE !,"and the AUTO SEND parameter is set to no. (To be used when Pharmacy can"
+6 WRITE !,"possibly correct a locally filled or CMOP Rx.)"
+7 QUIT
+8 ;
RRRMSG ; Reject Resolution Required Informational Message (called by PSOBPSSP, which was too big)
+1 WRITE !!,"All Reject Resolution Required reject codes will automatically be placed"
+2 WRITE !,"on the Third Party Payer Rejects - Worklist. This parameter applies to"
+3 WRITE !,"rejects for original unreleased fills only. Prescriptions will not be filled"
+4 WRITE !,"until the rejects identified by the Reject Resolution parameter are resolved."
+5 QUIT
