- APCPTAPE ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE GENERATE TAPE OF TRANSACTIONS XBGUST 14, 1992 ; [ 02/11/03 10:32 AM ]
- ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998
- ;
- ;
- ; APCP("QFLG") values set by this routine:
- ; Value Meaning
- ; 0 All ok
- ; 1 Site file error (^APCPSCHK)
- ; 41 No transactions to send
- ; 30 Unable to lock transaction global
- ; 43 Device not ready or open error (^APCPOPEN)
- ; 44 Tape write error [DSM only]
- ; 45 Operator "^" or NULL out [DSM only] (^APCPOPEN)
- ; 46 Unable to determine Operating System
- ;
- START ;
- S APCP("QFLG")=0
- D GETLOG
- I APCP("RUN LOG")="" K APCP("RUN LOG") Q
- D EN
- K APCP("RUN LOG"),APCPS,APCP
- Q
- EN ;ENTRY POINT
- D BASICS ; Do basic initialization
- I APCP("QFLG") D EOJ Q
- S XBGL="BAPCDATA",XBMED=APCP("DEF DEVICE"),XBNAR="PCC FACILITY",XBTLE="PCC DATA TRANSMISSION TO APC,INPT,CHA,STATISTICAL DB"
- S XBFN=$P(^APCPLOG(APCP("RUN LOG"),0),U,24)
- D ^XBGSAVE
- I XBFLG=-1 S APCP("QUIT")="" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G EOJ
- ;update log file .15 with date
- K DR,DIE,DA S DIE="^APCPLOG(",DR=".15///C",DA=APCP("RUN LOG") D ^DIE K DIE,DR,DA
- D EOJ
- Q
- ;
- GETLOG ;
- S APCP("RUN LOG")=""
- S DIC("S")="I $P(^APCPLOG(Y,0),U,15)=""P""",DIC="^APCPLOG(",DIC(0)="AEMQ" D ^DIC K DIC,DA
- I Y<0 Q
- S APCP("RUN LOG")=+Y
- Q
- BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
- K APCP("QUIT")
- S APCP("QFLG")=0,APCP("TAPE COUNT")=0
- D CHKSITE^APCPDRI ; Make sure Site file has correct fields
- Q:APCP("QFLG")
- I '$D(^BAPCDATA) W:'$D(ZTQUEUED) !!,"*** No APC, INPATIENT OR CHA transactions to send! ***" S APCP("QFLG")=28 Q
- I '$D(^BAPCDATA(0)) W:'$D(ZTQUEUED) !!,"*** The Transaction process NEVER complete properly!!" S APCP("QFLG")=29 Q
- I $P(^APCPLOG(APCP("RUN LOG"),0),U,15)'="P" W:'$D(ZTQUEUED) !!,$C(7),$C(7),"The Transaction Generation process never successfully completed!!",!! S APCP("QFLG")=31 Q
- L +^BAPCDATA:15 E W:'$D(ZTQUEUED) !!,"*** Unable to lock transaction global! ***" S APCP("QFLG")=30 Q
- K APCP("QUIT")
- S APCP("DEF DEVICE")=$P(^APCPSITE(1,0),U,2)
- I APCP("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S APCP("QFLG")=4 Q
- I ^%ZOSF("OS")["DSM","TC"'[APCP("DEF DEVICE") W:'$D(ZTQUEUED) !,"NOTIFY YOUR SUPERVISOR - The default device in the Site file is not",!,"compatible with a DSM system.",!,$C(7),$C(7) S APCP("QFLG")=4 Q
- W:'$D(ZTQUEUED) !,"The transactions will be written to ",$S(APCP("DEF DEVICE")="C":"a CARTRIDGE TAPE",APCP("DEF DEVICE")="F":"a HOST FILE",APCP("DEF DEVICE")="T":"a 9 TRACK TAPE",APCP("DEF DEVICE")="D":"a FLOPPY DISKETTE",1:"ERROR")
- CONT Q:$D(ZTQUEUED)
- Q:$P(^APCPSITE(1,0),U,11)="Y"
- S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" K DA D ^DIR K DIR
- I $D(DIRUT)!('Y) W !,"Transactions are NOT being written to an output device",! S APCP("QUIT")="",APCP("QFLG")=99 Q
- Q
- ;
- EOJ ;
- I 'APCP("QFLG"),'$D(APCP("QUIT")) K ^BAPCDATA ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
- K APCPV("TX"),APCP("XX"),XBFLG
- L -^BAPCDATA:15
- Q
- APCPTAPE ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE GENERATE TAPE OF TRANSACTIONS XBGUST 14, 1992 ; [ 02/11/03 10:32 AM ]
- +1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998
- +2 ;
- +3 ;
- +4 ; APCP("QFLG") values set by this routine:
- +5 ; Value Meaning
- +6 ; 0 All ok
- +7 ; 1 Site file error (^APCPSCHK)
- +8 ; 41 No transactions to send
- +9 ; 30 Unable to lock transaction global
- +10 ; 43 Device not ready or open error (^APCPOPEN)
- +11 ; 44 Tape write error [DSM only]
- +12 ; 45 Operator "^" or NULL out [DSM only] (^APCPOPEN)
- +13 ; 46 Unable to determine Operating System
- +14 ;
- START ;
- +1 SET APCP("QFLG")=0
- +2 DO GETLOG
- +3 IF APCP("RUN LOG")=""
- KILL APCP("RUN LOG")
- QUIT
- +4 DO EN
- +5 KILL APCP("RUN LOG"),APCPS,APCP
- +6 QUIT
- EN ;ENTRY POINT
- +1 ; Do basic initialization
- DO BASICS
- +2 IF APCP("QFLG")
- DO EOJ
- QUIT
- +3 SET XBGL="BAPCDATA"
- SET XBMED=APCP("DEF DEVICE")
- SET XBNAR="PCC FACILITY"
- SET XBTLE="PCC DATA TRANSMISSION TO APC,INPT,CHA,STATISTICAL DB"
- +4 SET XBFN=$PIECE(^APCPLOG(APCP("RUN LOG"),0),U,24)
- +5 DO ^XBGSAVE
- +6 IF XBFLG=-1
- SET APCP("QUIT")=""
- IF '$DATA(ZTQUEUED)
- WRITE !,$CHAR(7),$CHAR(7),XBFLG(1)
- GOTO EOJ
- +7 ;update log file .15 with date
- +8 KILL DR,DIE,DA
- SET DIE="^APCPLOG("
- SET DR=".15///C"
- SET DA=APCP("RUN LOG")
- DO ^DIE
- KILL DIE,DR,DA
- +9 DO EOJ
- +10 QUIT
- +11 ;
- GETLOG ;
- +1 SET APCP("RUN LOG")=""
- +2 SET DIC("S")="I $P(^APCPLOG(Y,0),U,15)=""P"""
- SET DIC="^APCPLOG("
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC,DA
- +3 IF Y<0
- QUIT
- +4 SET APCP("RUN LOG")=+Y
- +5 QUIT
- BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
- +1 KILL APCP("QUIT")
- +2 SET APCP("QFLG")=0
- SET APCP("TAPE COUNT")=0
- +3 ; Make sure Site file has correct fields
- DO CHKSITE^APCPDRI
- +4 IF APCP("QFLG")
- QUIT
- +5 IF '$DATA(^BAPCDATA)
- IF '$DATA(ZTQUEUED)
- WRITE !!,"*** No APC, INPATIENT OR CHA transactions to send! ***"
- SET APCP("QFLG")=28
- QUIT
- +6 IF '$DATA(^BAPCDATA(0))
- IF '$DATA(ZTQUEUED)
- WRITE !!,"*** The Transaction process NEVER complete properly!!"
- SET APCP("QFLG")=29
- QUIT
- +7 IF $PIECE(^APCPLOG(APCP("RUN LOG"),0),U,15)'="P"
- IF '$DATA(ZTQUEUED)
- WRITE !!,$CHAR(7),$CHAR(7),"The Transaction Generation process never successfully completed!!",!!
- SET APCP("QFLG")=31
- QUIT
- +8 LOCK +^BAPCDATA:15
- IF '$TEST
- IF '$DATA(ZTQUEUED)
- WRITE !!,"*** Unable to lock transaction global! ***"
- SET APCP("QFLG")=30
- QUIT
- +9 KILL APCP("QUIT")
- +10 SET APCP("DEF DEVICE")=$PIECE(^APCPSITE(1,0),U,2)
- +11 IF APCP("DEF DEVICE")=""
- IF '$DATA(ZTQUEUED)
- WRITE !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$CHAR(7),$CHAR(7)
- SET APCP("QFLG")=4
- QUIT
- +12 IF ^%ZOSF("OS")["DSM"
- IF "TC"'[APCP("DEF DEVICE")
- IF '$DATA(ZTQUEUED)
- WRITE !,"NOTIFY YOUR SUPERVISOR - The default device in the Site file is not",!,"compatible with a DSM system.",!,$CHAR(7),$CHAR(7)
- SET APCP("QFLG")=4
- QUIT
- +13 IF '$DATA(ZTQUEUED)
- WRITE !,"The transactions will be written to ",$SELECT(APCP("DEF DEVICE")="C":"a CARTRIDGE TAPE",APCP("DEF DEVICE")="F":"a HOST FILE",APCP("DEF DEVICE")="T":"a 9 TRACK TAPE",APCP("DEF DEVICE")="D":"a FLOPPY DISKETTE",1:"ERROR")
- CONT IF $DATA(ZTQUEUED)
- QUIT
- +1 IF $PIECE(^APCPSITE(1,0),U,11)="Y"
- QUIT
- +2 SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue"
- SET DIR("B")="Y"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)!('Y)
- WRITE !,"Transactions are NOT being written to an output device",!
- SET APCP("QUIT")=""
- SET APCP("QFLG")=99
- QUIT
- +4 QUIT
- +5 ;
- EOJ ;
- +1 ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
- IF 'APCP("QFLG")
- IF '$DATA(APCP("QUIT"))
- KILL ^BAPCDATA
- +2 KILL APCPV("TX"),APCP("XX"),XBFLG
- +3 LOCK -^BAPCDATA:15
- +4 QUIT
