ORY306PR ;ISL/JLC - Post-install for patch OR*3*306 ;12/07/12 06:14
;;3.0;ORDER ENTRY/RESULTS REPORTING;**306**;Dec 17, 1997;Build 43
;
;
QPR ; queue provider report to occur monthly
N WHEN,%,X1,X2,X,Y,YR,DT,MN
D LMES("Queue Monthly CS Report by Provider...",10,"B")
D OPTSTAT^XUTMOPT("OR EPCS CS RX BY PROVIDER",.INFO) ;first, check for an existing schedule
S Y=$P($G(INFO(1)),"^",2)
D DD^%DT
S WHEN=Y
I $P($G(INFO(1)),"^",2)]"" D ;;already scheduled
. D LMES("'OR EPCS CS RX BY PROVIDER' scheduled for "_WHEN,15)
E D ;
. S DT=$$NOW^XLFDT,YR=$E(DT,1,3)+1700,MN=$E(100+$E(DT,4,5),2,99) S MN=MN+1 I MN>12 S MN=1,YR=YR+1
. S YR=YR-1700,WHEN=$P(YR_$E(MN+100,2,3)_"01",".")_".21"
. D RESCH^XUTMOPT("OR EPCS CS RX BY PROVIDER",WHEN,"","1M","L")
. S Y=WHEN
. D DD^%DT
. S WHEN=Y
. D LMES("'OR EPCS CS RX BY PROVIDER' scheduled for "_WHEN,15)
;
D LMES("Continuing...",20)
D LMES("",1,"B")
Q
LMES(STR,SPCNUM,BVAR) ; List text in output display
;
; INPUT:
; STR - String to output
; SPCNUM - # Leading spaces
; BVAR - Null: Do not print a blank prior to text (Default) [MES]
; "B" : Print a blank prior to text [BMES]
N ORMSG
S ORMSG=""
S:+$G(SPCNUM)=0 SPCNUM=1
S $P(ORMSG," ",+$G(SPCNUM))=STR
D:$G(BVAR)'="B" MES^XPDUTL(ORMSG)
D:$G(BVAR)="B" BMES^XPDUTL(ORMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY306PR 1356 printed Sep 23, 2025@20:17:23 Page 2
ORY306PR ;ISL/JLC - Post-install for patch OR*3*306 ;12/07/12 06:14
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**306**;Dec 17, 1997;Build 43
+2 ;
+3 ;
QPR ; queue provider report to occur monthly
+1 NEW WHEN,%,X1,X2,X,Y,YR,DT,MN
+2 DO LMES("Queue Monthly CS Report by Provider...",10,"B")
+3 ;first, check for an existing schedule
DO OPTSTAT^XUTMOPT("OR EPCS CS RX BY PROVIDER",.INFO)
+4 SET Y=$PIECE($GET(INFO(1)),"^",2)
+5 DO DD^%DT
+6 SET WHEN=Y
+7 ;;already scheduled
IF $PIECE($GET(INFO(1)),"^",2)]""
Begin DoDot:1
+8 DO LMES("'OR EPCS CS RX BY PROVIDER' scheduled for "_WHEN,15)
End DoDot:1
+9 ;
IF '$TEST
Begin DoDot:1
+10 SET DT=$$NOW^XLFDT
SET YR=$EXTRACT(DT,1,3)+1700
SET MN=$EXTRACT(100+$EXTRACT(DT,4,5),2,99)
SET MN=MN+1
IF MN>12
SET MN=1
SET YR=YR+1
+11 SET YR=YR-1700
SET WHEN=$PIECE(YR_$EXTRACT(MN+100,2,3)_"01",".")_".21"
+12 DO RESCH^XUTMOPT("OR EPCS CS RX BY PROVIDER",WHEN,"","1M","L")
+13 SET Y=WHEN
+14 DO DD^%DT
+15 SET WHEN=Y
+16 DO LMES("'OR EPCS CS RX BY PROVIDER' scheduled for "_WHEN,15)
End DoDot:1
+17 ;
+18 DO LMES("Continuing...",20)
+19 DO LMES("",1,"B")
+20 QUIT
LMES(STR,SPCNUM,BVAR) ; List text in output display
+1 ;
+2 ; INPUT:
+3 ; STR - String to output
+4 ; SPCNUM - # Leading spaces
+5 ; BVAR - Null: Do not print a blank prior to text (Default) [MES]
+6 ; "B" : Print a blank prior to text [BMES]
+7 NEW ORMSG
+8 SET ORMSG=""
+9 if +$GET(SPCNUM)=0
SET SPCNUM=1
+10 SET $PIECE(ORMSG," ",+$GET(SPCNUM))=STR
+11 if $GET(BVAR)'="B"
DO MES^XPDUTL(ORMSG)
+12 if $GET(BVAR)="B"
DO BMES^XPDUTL(ORMSG)
+13 QUIT
