ASMTLOG2 ;PRINT LISTS OF CARTRIDGES ALREADY MAILED [ 11/21/85 3:56 PM ]
;IHS-OKLA CITY AREA OFFICE-LMD
A1 D ^AUCLS W "RPMS DATA CARTRIDGE MAILING LISTS......",!!!
A2 W !!,"Enter the BEGINNING DATE for this report: " D SBRS Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DLOUT) S:$D(DQOUT) Y="?" S DTIME=300,X=Y,%DT="XEP" D ^%DT G A2:Y<1 S ASM("START")=Y I Y>DT W !!,*7,"Do not use future dates." H 1 G A2
A3 W !!,"Enter the ENDING DATE for this report: " D SBRS Q:$D(DFOUT)!$D(DTOUT)!$D(DLOUT) G A2:$D(DUOUT) S:$D(DQOUT) Y="?" S DTIME=300,X=Y,%DT="XEP" D ^%DT G A3:Y<1 S ASM("END")=Y I Y>DT W !!,*7,"Do not use future dates." H 1 G A3
A4 G A5:ASM("START")'>ASM("END") W !!,*7,"INVALID ENTRY - The END is before the BEGINNING." H 3 G A2
A5 G QUE
START ;PRINT LIST OF MAILED CARTRIDGES
B1 S ASM=ASM("START")-1
B2 S ASM=$O(^AZOTXST("AC",ASM)) G END:ASM>ASM("END")!(ASM="") S ASM(1)=0,Y=ASM X ^DD("DD") S ASM("DT")=Y,PG=0 D HEADING
B2A S ASM(1)=$O(^AZOTXST("AC",ASM,ASM(1))) G B2:ASM(1)="" S ASM(2)=0
B2B S ASM(2)=$O(^AZOTXST("AC",ASM,ASM(1),ASM(2))) G B2A:ASM(2)="" S ASM(3)=0
B2C S ASM(3)=$O(^AZOTXST("AC",ASM,ASM(1),ASM(2),ASM(3))) G B2B:ASM(3)=""
S ASM("GL")=^AZOTXST(ASM(1),1,ASM(2),1,ASM(3),0)
B3 W ?5,$P(^AUTTLOC(ASM(1),0),"^",1),?42,$P($T(@$P(ASM("GL"),"^",1)),";;",2),?56,$P(ASM("GL"),"^",5),! D HEADING:$Y>50 G B2C
END W @IOF K ASM Q
SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:USTO I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q
S:Y="" DLOUT="" S:Y="/.," (DFOUT,Y)="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
Q
YN W !!,"Enter a ""Y"" for YES or an ""N"" for NO." H 2 Q
PRQ S ASM("START")=^%ZTSK(ZTSK,"START"),ASM("END")=^("END")
PRQ1 S:$D(^%ZTSK(ZTSK,"SITE")) SITENUM=^%ZTSK(ZTSK,"SITE") S U="^" K ^%ZTSK(ZTSK) G START
QUE D ^%AUQUE G START:$D(AU("PRINT")) Q:'$D(AU("QUE"))
QUE1 S ^%ZTSK(ZTSK,0)="PRQ^ASMTLOG2"_^%ZTSK(ZTSK,0),^("START")=ASM("START"),^("END")=ASM("END")
QUEND K ZTSK Q
HEADING U IO W @IOF
S PG=PG+1,LOC=^DD("SITE"),TITLE="R.P.M.S. DATA CARTRIDGE MAILING LIST",AG("TM")=$P($H,",",2),AG("HR")=AG("TM")\3600,AG("MIN")=AG("TM")#3600\60
S:AG("MIN")<10 AG("MIN")="0"_AG("MIN") S TME=AG("HR")_":"_AG("MIN"),USER=$P(^DIC(3,DUZ,0),"^",2)
W !!,USER,?80-$L(LOC)\2,LOC,?72,"page ",PG,!,TME,?80-$L(TITLE)\2,TITLE S Y=DT X ^DD("DD") W ?78-$L(Y),Y,!!!,"THE FOLLOWING CARTRIDGES WERE MAILED ON: ",ASM("DT"),!
LABEL W !!,?15,"FACILITY",?42,"DATA",?52,"# OF RECORDS" S AG("LINE")="=" D LINE Q
LINE S:'$D(AG("PRL")) AG("OLD")="" S:AG("OLD")'=AG("LINE") AG("PRL")="",$P(AG("PRL"),AG("LINE"),79)="",AG("OLD")=AG("LINE") W !,AG("PRL"),! Q
AG ;;REG
AAPC ;;APC
ACHS ;;CHS
ASMTLOG2 ;PRINT LISTS OF CARTRIDGES ALREADY MAILED [ 11/21/85 3:56 PM ]
+1 ;IHS-OKLA CITY AREA OFFICE-LMD
A1 DO ^AUCLS
WRITE "RPMS DATA CARTRIDGE MAILING LISTS......",!!!
A2 WRITE !!,"Enter the BEGINNING DATE for this report: "
DO SBRS
IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
QUIT
IF $DATA(DQOUT)
SET Y="?"
SET DTIME=300
SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A2
SET ASM("START")=Y
IF Y>DT
WRITE !!,*7,"Do not use future dates."
HANG 1
GOTO A2
A3 WRITE !!,"Enter the ENDING DATE for this report: "
DO SBRS
IF $DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
QUIT
IF $DATA(DUOUT)
GOTO A2
IF $DATA(DQOUT)
SET Y="?"
SET DTIME=300
SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A3
SET ASM("END")=Y
IF Y>DT
WRITE !!,*7,"Do not use future dates."
HANG 1
GOTO A3
A4 IF ASM("START")'>ASM("END")
GOTO A5
WRITE !!,*7,"INVALID ENTRY - The END is before the BEGINNING."
HANG 3
GOTO A2
A5 GOTO QUE
START ;PRINT LIST OF MAILED CARTRIDGES
B1 SET ASM=ASM("START")-1
B2 SET ASM=$ORDER(^AZOTXST("AC",ASM))
IF ASM>ASM("END")!(ASM="")
GOTO END
SET ASM(1)=0
SET Y=ASM
XECUTE ^DD("DD")
SET ASM("DT")=Y
SET PG=0
DO HEADING
B2A SET ASM(1)=$ORDER(^AZOTXST("AC",ASM,ASM(1)))
IF ASM(1)=""
GOTO B2
SET ASM(2)=0
B2B SET ASM(2)=$ORDER(^AZOTXST("AC",ASM,ASM(1),ASM(2)))
IF ASM(2)=""
GOTO B2A
SET ASM(3)=0
B2C SET ASM(3)=$ORDER(^AZOTXST("AC",ASM,ASM(1),ASM(2),ASM(3)))
IF ASM(3)=""
GOTO B2B
+1 SET ASM("GL")=^AZOTXST(ASM(1),1,ASM(2),1,ASM(3),0)
B3 WRITE ?5,$PIECE(^AUTTLOC(ASM(1),0),"^",1),?42,$PIECE($TEXT(@$PIECE(ASM("GL"),"^",1)),";;",2),?56,$PIECE(ASM("GL"),"^",5),!
IF $Y>50
DO HEADING
GOTO B2C
END WRITE @IOF
KILL ASM
QUIT
SBRS KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
READ Y:USTO
IF '$TEST
WRITE *7
READ Y:5
IF Y="."
GOTO SBRS
IF '$TEST
SET (DTOUT,Y)=""
QUIT
+1 IF Y=""
SET DLOUT=""
IF Y="/.,"
SET (DFOUT,Y)=""
IF Y="^"
SET (DUOUT,Y)=""
IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+2 QUIT
YN WRITE !!,"Enter a ""Y"" for YES or an ""N"" for NO."
HANG 2
QUIT
PRQ SET ASM("START")=^%ZTSK(ZTSK,"START")
SET ASM("END")=^("END")
PRQ1 IF $DATA(^%ZTSK(ZTSK,"SITE"))
SET SITENUM=^%ZTSK(ZTSK,"SITE")
SET U="^"
KILL ^%ZTSK(ZTSK)
GOTO START
QUE DO ^%AUQUE
IF $DATA(AU("PRINT"))
GOTO START
IF '$DATA(AU("QUE"))
QUIT
QUE1 SET ^%ZTSK(ZTSK,0)="PRQ^ASMTLOG2"_^%ZTSK(ZTSK,0)
SET ^("START")=ASM("START")
SET ^("END")=ASM("END")
QUEND KILL ZTSK
QUIT
HEADING USE IO
WRITE @IOF
+1 SET PG=PG+1
SET LOC=^DD("SITE")
SET TITLE="R.P.M.S. DATA CARTRIDGE MAILING LIST"
SET AG("TM")=$PIECE($HOROLOG,",",2)
SET AG("HR")=AG("TM")\3600
SET AG("MIN")=AG("TM")#3600\60
+2 IF AG("MIN")<10
SET AG("MIN")="0"_AG("MIN")
SET TME=AG("HR")_":"_AG("MIN")
SET USER=$PIECE(^DIC(3,DUZ,0),"^",2)
+3 WRITE !!,USER,?80-$LENGTH(LOC)\2,LOC,?72,"page ",PG,!,TME,?80-$LENGTH(TITLE)\2,TITLE
SET Y=DT
XECUTE ^DD("DD")
WRITE ?78-$LENGTH(Y),Y,!!!,"THE FOLLOWING CARTRIDGES WERE MAILED ON: ",ASM("DT"),!
LABEL WRITE !!,?15,"FACILITY",?42,"DATA",?52,"# OF RECORDS"
SET AG("LINE")="="
DO LINE
QUIT
LINE IF '$DATA(AG("PRL"))
SET AG("OLD")=""
IF AG("OLD")'=AG("LINE")
SET AG("PRL")=""
SET $PIECE(AG("PRL"),AG("LINE"),79)=""
SET AG("OLD")=AG("LINE")
WRITE !,AG("PRL"),!
QUIT
AG ;;REG
AAPC ;;APC
ACHS ;;CHS
