ORY306PR.m

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 ---ORY306PR   1356     printed  Apr 09, 2024@21:32:29                                                                                                                                                                                                    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