| 1 | ABSV88A ;VAMC ALTOONA/CTB - TRANSMIT TT88'S AND TT04'S TO AUSTIN ;4/13/00 12:19 PM
|
---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**7,11,18**;JULY 6, 1994
|
---|
| 3 | NEW %,%W,%X,%Y,COUNT,D,D0,D1,DA,DI,DIC,DIE,DQ,DR,I,MSGNUM,N,X,XCNP,XMDUZ,XMZ
|
---|
| 4 | D ^ABSVSITE Q:'%
|
---|
| 5 | S ABSVXA="This program will transmit master record changes made on your DHCP system, to the Austin DPC.",ABSVXA(1)="",ABSVXA(2)="Do you wish to proceed",%=1,ABSVXB=""
|
---|
| 6 | D ^ABSVYN I %'=1 S X="<No Action Taken>" D MSG^ABSVQ,OUT QUIT
|
---|
| 7 | ;BUILD LIST OF RECORDS NEEDING TT88'S TRANSMITTED TO AUSTIN.
|
---|
| 8 | D WAIT^ABSVYN W ! S X="Updating the SEX field for Volunteers from B/G to M/F." D MSG^ABSVQ
|
---|
| 9 | D ^ABSVBGMF W !!
|
---|
| 10 | D WAIT^ABSVYN
|
---|
| 11 | W ! S X="Searching file for Master Records requiring TT 88's." D MSG^ABSVQ
|
---|
| 12 | K ^TMP($J,"ABSVTT88"),^TMP($J,"ABSVLIST")
|
---|
| 13 | S DA=0 F S DA=$O(^ABS(503330,"AF",1,DA)) Q:'DA I $D(^ABS(503330,"AF",1,DA,ABSV("INST"))) S ^TMP($J,"ABSVLIST",DA)=""
|
---|
| 14 | S DA=0 F S DA=$O(^ABS(503330,"AG",1,DA)) Q:'DA I $D(^ABS(503330,"AG",1,DA,ABSV("INST"))) S ^TMP($J,"ABSVLIST",DA)=""
|
---|
| 15 | S DA=0,MSGNUM=1 F D Q:'DA S MSGNUM=MSGNUM+1
|
---|
| 16 | . F COUNT=1:1:150 S DA=$O(^TMP($J,"ABSVLIST",DA)) Q:'DA S ^TMP($J,"ABSVTT88",ABSV("INST"),MSGNUM,COUNT,0)=$$ONE^ABSV88(DA,ABSV("INST"),ABSV("SITE")) W "."
|
---|
| 17 | . QUIT
|
---|
| 18 | I '$D(^TMP($J,"ABSVTT88")) S X="There are no master records on file requiring TT 88's for transmission to Austin. No further action taken." D MSG^ABSVQ
|
---|
| 19 | S MSGNUM=0 F S MSGNUM=$O(^TMP($J,"ABSVTT88",ABSV("INST"),MSGNUM)) Q:'MSGNUM D
|
---|
| 20 | . S XMDUZ=$S($G(DUZ)]"":DUZ,1:.5),XMSUB="VOLUNTARY TRANSACTION TYPE 88'S - "_ABSV("SITE"),XMTEXT="^TMP("_$J_",""ABSVTT88"","_ABSV("INST")_","_MSGNUM_","
|
---|
| 21 | . S XMY("XXX@Q-NST.VA.GOV")=""
|
---|
| 22 | . S XMY("G.NST")=""
|
---|
| 23 | . D ^XMD
|
---|
| 24 | . W !,XMZ," - Message Filed"
|
---|
| 25 | . QUIT
|
---|
| 26 | ;DELETE CROSS REFERENCES FOR TT88 AND 04'S
|
---|
| 27 | F S DA(1)=$O(^TMP($J,"ABSVLIST",0)) Q:'DA(1) D
|
---|
| 28 | . S DIE="^ABS(503330,"_DA(1)_",4,",DA=ABSV("INST"),DR="11///@;12///@;13////0;14///@;15///@;16///@;17///@;8///@" D ^DIE
|
---|
| 29 | . K ^TMP($J,"ABSVLIST",DA(1))
|
---|
| 30 | . W "." QUIT
|
---|
| 31 | QUIT
|
---|
| 32 | OUT QUIT
|
---|