- 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 Mar 13, 2025@21:46:03 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