- 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
