- PSXRPT ;BIR/WPB,HTW-Routine to Generate Reports at the CMOP Host Facility ;04/08/97 2:06 PM
- ;;2.0;CMOP;**38**;11 Apr 97
- PRINT S FROM=$P($G(^PSX(552.1,REC,"P")),U,1),BB=$P($G(^PSX(552.1,REC,0)),U,1)
- S BAT=$P($G(BB),"-",2),RESP="",STA1=$P($G(BB),"-")
- ;I $G(STA1)]"" S X=STA1,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S STA2=+Y,STATION=$P(Y,"^",2) K DIC,Y,X ;****DOD L1
- I $G(STA1)]"" S X=STA1,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S STA2=$$IEN^XUMF(4,AGNCY,X),STATION=$$NAME^XUAF4(STA2) K AGNCY,Y,X ;****DOD L1
- S ORDS=$P($G(^PSX(552.1,REC,1)),U,3),RXS=$P($G(^(1)),U,4)
- S SS=$P($G(^PSX(552.1,REC,0)),U,2)
- S STAT=$S(SS=2:"Queued",SS=3:"Processed",SS=4:"Closed",SS=5:"Hold",SS=6:"Printed",SS=99:"Rejected",1:"")
- S Y=RDTTM X ^DD("DD") S RDTTM=Y K Y S RDTTM=$P(RDTTM,":",1,2)
- W !,RDTTM,?19,FROM,?43,BB,?59,$J(ORDS,5),?68,$J(RXS,5),?75,$E(STAT,1,4) S LN=LN+1
- ;W !,RDTTM,?20,FROM,?44,BB,?54,$J(ORDS,5),?63,$J(RXS,5),?70,STAT S LN=LN+1
- I $G(IOST)["C-" D
- .Q:LN<22
- .I LN>21 S RESP="",LN=0,DIR(0)="E" D ^DIR S:(Y='1)!($D(DTOUT)) RESP="^" K DIR Q:Y'=1 K Y,X,DIRUT,DIROUT,DTOUT,DUOUT
- .S LN=0
- .W @IOF,!
- .W !,?29,"TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
- .W !,?30,RDATE,!! S LN=LN+3
- .;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- .;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- .W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- .W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- .S LL="-" F JJ=0:1:79 W LL
- .W ! S LN=LN+3
- I $G(IOST)'["C-"&(LN>60) D
- .S LN=0
- .W @IOF,!
- .W !,?29,"TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
- .W !,?30,RDATE,!! S LN=LN+3
- .;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- .;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- .W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- .W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- .S LL="-" F JJ=0:1:79 W LL
- .W ! S LN=LN+4
- Q:$G(RESP)="^"
- S NEXT=REC+1
- Q:'$D(^PSX(552.1,NEXT,0))
- Q
- EXIT I '$G(POP) S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
- EXIT1 W @IOF K RPT,XX,DATE,RDATE,Y,%,X,FROM,ORDS,RXS,BB,STAT,RESP,RDT,RDTTM,LL,BAT,REC,SS,SITE,JJ,LN,NEXT,STA1,STA2,STATION,COM,COM2,EE,END,ORD,REVD,SP,SP1,SP2,TBB,X1,XT,XY
- K ZTRTN,ZTIO,PSXLION,ZTDESC,ZTSAVE,ZTSK,%ZIS,DIR,DTOUT,DIROUT,DUOUT,DIRUT,^TMP($J,"PSXRPT")
- I $G(IOST)'["C-" W @IOF
- D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- QUE S ZTRTN="RPT^PSXRPT",ZTIO=PSXLION,ZTSAVE("RDT")="",ZTSAVE("RPT")="",ZTSAVE("END")="",ZTSAVE("TBB")="",ZTSAVE("ORD")="",ZTDESC="CMOP Transmission Report Summary" D ^%ZTLOAD
- I $D(ZTSK)[0 W !!,"Job Canceled"
- E W !!,"Job Queued"
- D HOME^%ZIS
- Q
- EN S DIR(0)="SOM^S:Summary;Q:Queued;P:Processed;C:Closed;H:Hold;L:Labels Printed"
- S DIR("A")="Select",DIR("B")="Q",DIR("??")="^D HELP^PSXRPT"
- D ^DIR K DIR S RPT=Y G:Y=0 EXIT1 G:$D(DIRUT) EXIT1
- K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- ;G:"HL"[RPT R1
- S DIR(0)="S^A:Ascending Order;D:Descending Order",DIR("B")="Ascending",DIR("??")="^D HELP1^PSXRPT"
- D ^DIR K DIR S ORD=Y Q:Y=""!($D(DIRUT))!($D(DUOUT))!($D(DIROUT))!($D(DTOUT))
- K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- I "SQPCHL"'[RPT Q
- R1 I "SCPLHQ"[RPT D G:$G(Y)<0 EXIT
- .S:"HL"[RPT ORD="A"
- .W !! S %DT="AEX",%DT("A")="Enter Begin Date for Report: ",%DT(0)="-NOW",%DT("B")="TODAY" D ^%DT Q:Y<0!($D(DTOUT)) S TBB=Y,RDT=$$FMADD^XLFDT(TBB,-1,0,0,0)_".9999"
- .W ! S %DT("A")="Enter End Date for Report: " D ^%DT K %DT Q:Y<0!($D(DTOUT)) S EE=Y,END=EE_".9999"
- .K %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
- .I TBB>EE W !,"Beginning date must be before ending date." G R1
- DEV S %ZIS="Q" D ^%ZIS S PSXLION=ION G:$G(IOST)["C-"&('POP) RPT I POP W !,"NO DEVICE SELECTED" G EXIT
- I $D(IO("Q")) D QUE,EXIT1 Q
- I '$D(IO("Q")) G RPT
- Q
- ;Taskman entry point to start the transmission summary report
- RPT D NOW^%DTC S Y=% X ^DD("DD") S DATE=Y,RDATE=$P(DATE,"@",1)_" "_$E($P(DATE,"@",2),1,5),LN=0
- I '$D(ZTSK) U IO
- W @IOF
- HDR S COM="TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY"),COM2=$P($$FMTE^XLFDT(TBB,"2S"),"@",1)_" THRU "_$P($$FMTE^XLFDT(END,"2S"),"@",1)
- S SP2=(80-$L(COM2))/2,SP=(80-$L(COM))/2,SP1=(80-$L(RDATE))/2
- W !,?SP,COM,!,?SP2,COM2,!! S LN=LN+4
- ;W !,?SP1,RDATE,!! S LN=LN+5
- W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- S LL="-" F JJ=0:1:79 W LL
- W ! S LN=LN+2
- I $G(ORD)="D" G DESC
- I (RPT="S")!(RPT="C")!(RPT="Q")!(RPT="P") G DATA
- I RPT="H"!(RPT="L") G QDATA
- W !!
- S DIR(0)="Y",DIR("B")="NO",DIR("A")="Another report" D ^DIR K DIR G:Y=1 EN
- G EXIT1
- Q
- DATA S XX=$S(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
- S XT=0,XY=RDT F S XY=$O(^PSX(552.1,XX,XY)) Q:XY=""!(XY>END) S XT=XT+1
- I '$D(^PSX(552.1,XX))!($G(XT)'>0) W !!,"No data for the report." G EXIT
- ;S RDT="" F S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="") S SITE="" F S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0 S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
- F S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")!(RDT>END) S SITE="" F S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0 S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
- G:$G(IOST)'["C-" EXIT1
- G EXIT
- QDATA S XX=$S(RPT="H":"AH",RPT="L":"AE",1:"")
- I '$D(^PSX(552.1,XX)) W !!,"No data for the report." G EXIT
- S SITE="" F S SITE=$O(^PSX(552.1,XX,SITE)) Q:'SITE F REC=0:0 S REC=$O(^PSX(552.1,XX,SITE,REC)) Q:REC'>0 S RDTTM=$P($G(^PSX(552.1,REC,0)),U,4) Q:RDTTM<TBB!(RDTTM>END) D PRINT G:RESP="^" EXIT1
- G:$G(IOST)'["C-" EXIT1
- G EXIT
- DESC S XX=$S(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
- S XT=0,XY=RDT F S XY=$O(^PSX(552.1,XX,XY)) Q:XY=""!(XY>END) S XT=XT+1
- I '$D(^PSX(552.1,XX))!($G(XT)'>0) W !!,"No data for the report." G EXIT
- F S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")!(RDT>END) S SITE="" F S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0 S REVD=9999999.9999-RDT,^TMP($J,"PSXRPT",REVD,REC)=""
- D DESC1
- Q
- DESC1 S X1="" F S X1=$O(^TMP($J,"PSXRPT",X1)) Q:X1="" S REC=0 F S REC=$O(^TMP($J,"PSXRPT",X1,REC)) Q:REC'>0 S RDTTM=$P(^PSX(552.1,REC,0),"^",4) K Y D PRINT G:RESP="^" EXIT1
- K X1,Y1
- G:$G(IOST)'["C-" EXIT1
- G EXIT
- HELP W !!,"S - Provides a report of all transmissions received for the date range entered."
- W !,"Q - Provides a report of all transmissions that are queued to download to the",!,"vendor for the date range entered."
- W !,"P - Provides a report of all transmissions that are processed for the date range",!,"entered."
- W !,"C - Provides a report of all transmissions that are closed for the date range",!,"entered."
- W !,"H - Provides a report of all transmissions that are on hold status for the date range entered."
- W !,"L - Provides a report of all transmissions that were printed for the date range entered."
- Q
- HELP1 W !!,"Ascending order will order data starting with the earliest date.",!,"Descending order will order the data starting the latest date."
- Q
- PSXRPT ;BIR/WPB,HTW-Routine to Generate Reports at the CMOP Host Facility ;04/08/97 2:06 PM
- +1 ;;2.0;CMOP;**38**;11 Apr 97
- PRINT SET FROM=$PIECE($GET(^PSX(552.1,REC,"P")),U,1)
- SET BB=$PIECE($GET(^PSX(552.1,REC,0)),U,1)
- +1 SET BAT=$PIECE($GET(BB),"-",2)
- SET RESP=""
- SET STA1=$PIECE($GET(BB),"-")
- +2 ;I $G(STA1)]"" S X=STA1,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S STA2=+Y,STATION=$P(Y,"^",2) K DIC,Y,X ;****DOD L1
- +3 ;****DOD L1
- IF $GET(STA1)]""
- SET X=STA1
- SET AGNCY="VASTANUM"
- IF $DATA(^PSX(552,"D",X))
- SET X=$EXTRACT(X,2,99)
- SET AGNCY="DMIS"
- SET STA2=$$IEN^XUMF(4,AGNCY,X)
- SET STATION=$$NAME^XUAF4(STA2)
- KILL AGNCY,Y,X
- +4 SET ORDS=$PIECE($GET(^PSX(552.1,REC,1)),U,3)
- SET RXS=$PIECE($GET(^(1)),U,4)
- +5 SET SS=$PIECE($GET(^PSX(552.1,REC,0)),U,2)
- +6 SET STAT=$SELECT(SS=2:"Queued",SS=3:"Processed",SS=4:"Closed",SS=5:"Hold",SS=6:"Printed",SS=99:"Rejected",1:"")
- +7 SET Y=RDTTM
- XECUTE ^DD("DD")
- SET RDTTM=Y
- KILL Y
- SET RDTTM=$PIECE(RDTTM,":",1,2)
- +8 WRITE !,RDTTM,?19,FROM,?43,BB,?59,$JUSTIFY(ORDS,5),?68,$JUSTIFY(RXS,5),?75,$EXTRACT(STAT,1,4)
- SET LN=LN+1
- +9 ;W !,RDTTM,?20,FROM,?44,BB,?54,$J(ORDS,5),?63,$J(RXS,5),?70,STAT S LN=LN+1
- +10 IF $GET(IOST)["C-"
- Begin DoDot:1
- +11 IF LN<22
- QUIT
- +12 IF LN>21
- SET RESP=""
- SET LN=0
- SET DIR(0)="E"
- DO ^DIR
- IF (Y='1)!($DATA(DTOUT))
- SET RESP="^"
- KILL DIR
- IF Y'=1
- QUIT
- KILL Y,X,DIRUT,DIROUT,DTOUT,DUOUT
- +13 SET LN=0
- +14 WRITE @IOF,!
- +15 WRITE !,?29,"TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
- +16 WRITE !,?30,RDATE,!!
- SET LN=LN+3
- +17 ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- +18 ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- +19 WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- +20 WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- +21 SET LL="-"
- FOR JJ=0:1:79
- WRITE LL
- +22 WRITE !
- SET LN=LN+3
- End DoDot:1
- +23 IF $GET(IOST)'["C-"&(LN>60)
- Begin DoDot:1
- +24 SET LN=0
- +25 WRITE @IOF,!
- +26 WRITE !,?29,"TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
- +27 WRITE !,?30,RDATE,!!
- SET LN=LN+3
- +28 ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- +29 ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- +30 WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- +31 WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- +32 SET LL="-"
- FOR JJ=0:1:79
- WRITE LL
- +33 WRITE !
- SET LN=LN+4
- End DoDot:1
- +34 IF $GET(RESP)="^"
- QUIT
- +35 SET NEXT=REC+1
- +36 IF '$DATA(^PSX(552.1,NEXT,0))
- QUIT
- +37 QUIT
- EXIT IF '$GET(POP)
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- EXIT1 WRITE @IOF
- KILL RPT,XX,DATE,RDATE,Y,%,X,FROM,ORDS,RXS,BB,STAT,RESP,RDT,RDTTM,LL,BAT,REC,SS,SITE,JJ,LN,NEXT,STA1,STA2,STATION,COM,COM2,EE,END,ORD,REVD,SP,SP1,SP2,TBB,X1,XT,XY
- +1 KILL ZTRTN,ZTIO,PSXLION,ZTDESC,ZTSAVE,ZTSK,%ZIS,DIR,DTOUT,DIROUT,DUOUT,DIRUT,^TMP($JOB,"PSXRPT")
- +2 IF $GET(IOST)'["C-"
- WRITE @IOF
- +3 DO ^%ZISC
- +4 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +5 QUIT
- QUE SET ZTRTN="RPT^PSXRPT"
- SET ZTIO=PSXLION
- SET ZTSAVE("RDT")=""
- SET ZTSAVE("RPT")=""
- SET ZTSAVE("END")=""
- SET ZTSAVE("TBB")=""
- SET ZTSAVE("ORD")=""
- SET ZTDESC="CMOP Transmission Report Summary"
- DO ^%ZTLOAD
- +1 IF $DATA(ZTSK)[0
- WRITE !!,"Job Canceled"
- +2 IF '$TEST
- WRITE !!,"Job Queued"
- +3 DO HOME^%ZIS
- +4 QUIT
- EN SET DIR(0)="SOM^S:Summary;Q:Queued;P:Processed;C:Closed;H:Hold;L:Labels Printed"
- +1 SET DIR("A")="Select"
- SET DIR("B")="Q"
- SET DIR("??")="^D HELP^PSXRPT"
- +2 DO ^DIR
- KILL DIR
- SET RPT=Y
- IF Y=0
- GOTO EXIT1
- IF $DATA(DIRUT)
- GOTO EXIT1
- +3 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- +4 ;G:"HL"[RPT R1
- +5 SET DIR(0)="S^A:Ascending Order;D:Descending Order"
- SET DIR("B")="Ascending"
- SET DIR("??")="^D HELP1^PSXRPT"
- +6 DO ^DIR
- KILL DIR
- SET ORD=Y
- IF Y=""!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT))!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT))!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT))!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT))
- QUIT
- +7 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- +8 IF "SQPCHL"'[RPT
- QUIT
- R1 IF "SCPLHQ"[RPT
- Begin DoDot:1
- +1 IF "HL"[RPT
- SET ORD="A"
- +2 WRITE !!
- SET %DT="AEX"
- SET %DT("A")="Enter Begin Date for Report: "
- SET %DT(0)="-NOW"
- SET %DT("B")="TODAY"
- DO ^%DT
- IF Y<0!($DATA(DTOUT))
- QUIT
- SET TBB=Y
- SET RDT=$$FMADD^XLFDT(TBB,-1,0,0,0)_".9999"
- +3 WRITE !
- SET %DT("A")="Enter End Date for Report: "
- DO ^%DT
- KILL %DT
- IF Y<0!($DATA(DTOUT))
- QUIT
- SET EE=Y
- SET END=EE_".9999"
- +4 KILL %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
- +5 IF TBB>EE
- WRITE !,"Beginning date must be before ending date."
- GOTO R1
- End DoDot:1
- IF $GET(Y)<0
- GOTO EXIT
- DEV SET %ZIS="Q"
- DO ^%ZIS
- SET PSXLION=ION
- IF $GET(IOST)["C-"&('POP)
- GOTO RPT
- IF POP
- WRITE !,"NO DEVICE SELECTED"
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- DO QUE
- DO EXIT1
- QUIT
- +2 IF '$DATA(IO("Q"))
- GOTO RPT
- +3 QUIT
- +4 ;Taskman entry point to start the transmission summary report
- RPT DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET DATE=Y
- SET RDATE=$PIECE(DATE,"@",1)_" "_$EXTRACT($PIECE(DATE,"@",2),1,5)
- SET LN=0
- +1 IF '$DATA(ZTSK)
- USE IO
- +2 WRITE @IOF
- HDR SET COM="TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
- SET COM2=$PIECE($$FMTE^XLFDT(TBB,"2S"),"@",1)_" THRU "_$PIECE($$FMTE^XLFDT(END,"2S"),"@",1)
- +1 SET SP2=(80-$LENGTH(COM2))/2
- SET SP=(80-$LENGTH(COM))/2
- SET SP1=(80-$LENGTH(RDATE))/2
- +2 WRITE !,?SP,COM,!,?SP2,COM2,!!
- SET LN=LN+4
- +3 ;W !,?SP1,RDATE,!! S LN=LN+5
- +4 WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
- +5 WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
- +6 ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
- +7 ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
- +8 SET LL="-"
- FOR JJ=0:1:79
- WRITE LL
- +9 WRITE !
- SET LN=LN+2
- +10 IF $GET(ORD)="D"
- GOTO DESC
- +11 IF (RPT="S")!(RPT="C")!(RPT="Q")!(RPT="P")
- GOTO DATA
- +12 IF RPT="H"!(RPT="L")
- GOTO QDATA
- +13 WRITE !!
- +14 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Another report"
- DO ^DIR
- KILL DIR
- IF Y=1
- GOTO EN
- +15 GOTO EXIT1
- +16 QUIT
- DATA SET XX=$SELECT(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
- +1 SET XT=0
- SET XY=RDT
- FOR
- SET XY=$ORDER(^PSX(552.1,XX,XY))
- IF XY=""!(XY>END)
- QUIT
- SET XT=XT+1
- +2 IF '$DATA(^PSX(552.1,XX))!($GET(XT)'>0)
- WRITE !!,"No data for the report."
- GOTO EXIT
- +3 ;S RDT="" F S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="") S SITE="" F S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0 S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
- +4 FOR
- SET RDT=$ORDER(^PSX(552.1,XX,RDT))
- IF (RDT="")!(RDT>END)
- QUIT
- SET SITE=""
- FOR
- SET SITE=$ORDER(^PSX(552.1,XX,RDT,SITE))
- IF 'SITE
- QUIT
- FOR REC=0:0
- SET REC=$ORDER(^PSX(552.1,XX,RDT,SITE,REC))
- IF REC'>0
- QUIT
- SET RDTTM=RDT
- KILL Y
- DO PRINT
- IF RESP="^"
- GOTO EXIT1
- +5 IF $GET(IOST)'["C-"
- GOTO EXIT1
- +6 GOTO EXIT
- QDATA SET XX=$SELECT(RPT="H":"AH",RPT="L":"AE",1:"")
- +1 IF '$DATA(^PSX(552.1,XX))
- WRITE !!,"No data for the report."
- GOTO EXIT
- +2 SET SITE=""
- FOR
- SET SITE=$ORDER(^PSX(552.1,XX,SITE))
- IF 'SITE
- QUIT
- FOR REC=0:0
- SET REC=$ORDER(^PSX(552.1,XX,SITE,REC))
- IF REC'>0
- QUIT
- SET RDTTM=$PIECE($GET(^PSX(552.1,REC,0)),U,4)
- IF RDTTM<TBB!(RDTTM>END)
- QUIT
- DO PRINT
- IF RESP="^"
- GOTO EXIT1
- +3 IF $GET(IOST)'["C-"
- GOTO EXIT1
- +4 GOTO EXIT
- DESC SET XX=$SELECT(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
- +1 SET XT=0
- SET XY=RDT
- FOR
- SET XY=$ORDER(^PSX(552.1,XX,XY))
- IF XY=""!(XY>END)
- QUIT
- SET XT=XT+1
- +2 IF '$DATA(^PSX(552.1,XX))!($GET(XT)'>0)
- WRITE !!,"No data for the report."
- GOTO EXIT
- +3 FOR
- SET RDT=$ORDER(^PSX(552.1,XX,RDT))
- IF (RDT="")!(RDT>END)
- QUIT
- SET SITE=""
- FOR
- SET SITE=$ORDER(^PSX(552.1,XX,RDT,SITE))
- IF 'SITE
- QUIT
- FOR REC=0:0
- SET REC=$ORDER(^PSX(552.1,XX,RDT,SITE,REC))
- IF REC'>0
- QUIT
- SET REVD=9999999.9999-RDT
- SET ^TMP($JOB,"PSXRPT",REVD,REC)=""
- +4 DO DESC1
- +5 QUIT
- DESC1 SET X1=""
- FOR
- SET X1=$ORDER(^TMP($JOB,"PSXRPT",X1))
- IF X1=""
- QUIT
- SET REC=0
- FOR
- SET REC=$ORDER(^TMP($JOB,"PSXRPT",X1,REC))
- IF REC'>0
- QUIT
- SET RDTTM=$PIECE(^PSX(552.1,REC,0),"^",4)
- KILL Y
- DO PRINT
- IF RESP="^"
- GOTO EXIT1
- +1 KILL X1,Y1
- +2 IF $GET(IOST)'["C-"
- GOTO EXIT1
- +3 GOTO EXIT
- HELP WRITE !!,"S - Provides a report of all transmissions received for the date range entered."
- +1 WRITE !,"Q - Provides a report of all transmissions that are queued to download to the",!,"vendor for the date range entered."
- +2 WRITE !,"P - Provides a report of all transmissions that are processed for the date range",!,"entered."
- +3 WRITE !,"C - Provides a report of all transmissions that are closed for the date range",!,"entered."
- +4 WRITE !,"H - Provides a report of all transmissions that are on hold status for the date range entered."
- +5 WRITE !,"L - Provides a report of all transmissions that were printed for the date range entered."
- +6 QUIT
- HELP1 WRITE !!,"Ascending order will order data starting with the earliest date.",!,"Descending order will order the data starting the latest date."
- +1 QUIT
