APCPDRI ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE INITIALIZATION FOR PCC TX DRIVERS AUGUST 14, 1992 ; [ 04/16/02 3:11 PM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,4,6**;APR 03, 1998
;IHS/CMI/LAB - patch 4 file 200 conversion check
;IHS/CMI/LAB - patch 2 force stat recs
;
START ;
D BASICS ; Set variables like U,DT,DUZ(2) etc.
D CHKSITE ; Make sure Site file has correct fields.
Q:APCP("QFLG")
;
D:APCPO("RUN")="NEW" ^APCPDRI2 ; Do new run initialization.
Q:$D(ZTQUEUED)
Q:APCP("QFLG")
D:APCPO("RUN")="NEW" QUEUE
Q
;
BASICS ; BASIC INITS
D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
K APCP,APCPS,APCPV,APCPT,APCPE
S APCP("RUN LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,10),APCP("QFLG")=0
S APCDOVRR=1 ; Allow VISIT lookup with 0 'dependent entry count'.
S (APCP("INPT"),APCP("CHA"),APCP("APC"),APCP("ERROR COUNT"),APCP("COUNT"),APCP("STAT"),APCP("DEL NEVER SENT"),APCP("DEMO PAT"),APCP("IN NO PP"))=0
Q
;
CHKSITE ;EP
;S APCPS("PROV FILE")=$S($P(^AUTTSITE(1,0),U,22):200,1:6)
S APCPS("PROV FILE")=$S($P(^DD(9000010.06,.01,0),U,2)[200:200,1:6)
I '$D(^AUTTSITE(1,0)) W:'$D(ZTQUEUED) !!,"*** RPMS SITE FILE has not been set up! ***" S APCP("QFLG")=1 Q
I $P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)="" W:'$D(ZTQUEUED) !!,"No ASUFAC for facility in RPMS Site file!!" S APCP("QFLG")=1 Q
I $P($G(^AUTTSITE(1,1)),U,3)="" W:'$D(ZTQUEUED) !!,"Static ASUFAC for this site is not set up!!" S APCP("QFLG")=33 Q
I '$D(^APCPSITE(1,0)) W:'$D(ZTQUEUED) !!,"*** Site file has not been setup! ***" S APCP("QFLG")=1 Q
I $P(^APCPSITE(1,0),U)'=DUZ(2) W:'$D(ZTQUEUED) !!,"*** RUN LOCATION not in SITE file!" S APCP("QFLG")=2 Q
I '$P(^APCPSITE(1,0),U,3) W:'$D(ZTQUEUED) !!,"*** No DELAY value in Site file! ***" S APCP("QFLG")=3
I $P(^APCPSITE(1,0),U,2)="" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S APCP("QFLG")=4
I $P(^APCPSITE(1,0),U,7)="Y" S APCPS("APC")=""
I $P(^APCPSITE(1,0),U,8)="Y" S APCPS("INPT")=""
I $P(^APCPSITE(1,0),U,9)="Y" S APCPS("CHA")=""
;I $P(^APCPSITE(1,0),U,12)="Y" S APCPS("STAT")="" ;IHS/CMI/LAB
S APCPS("ORYX")=$P(^APCPSITE(1,0),U,13)
S APCPS("STAT")="" ;IHS/CMI/LAB patch 2
I $D(APCPS)'=10 W:'$D(ZTQUEUED) !!,"*** Site file does not contain the type of system for sending transactions!! ****" S APCP("QFLG")=5 Q
Q
QUEUE ;EP
K ZTSK
S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y=1 D QUEUE1 Q
I APCPO("RUN")="NEW",$D(DIRUT) S APCP("QFLG")=99 S DA=APCP("RUN LOG"),DIK="^APCPLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
I APCPO("RUN")="REDO",$D(DIRUT) S APCP("QFLG")=99 Q
Q
QUEUE1 ;
S ZTRTN=$S(APCPO("RUN")="NEW":"DRIVER^APCPDR",1:"EN^APCPREDO")
S ZTIO="",ZTDTH="",ZTDESC="PCC DATA TRANSMISSION" S ZTSAVE("APCP*")="",ZTSAVE("APCD*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),APCPO("RUN")="NEW" S APCP("QFLG")=99 S DA=APCP("RUN LOG"),DIK="^APCPLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
S APCPO("QUEUE")=""
S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
APCPDRI ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE INITIALIZATION FOR PCC TX DRIVERS AUGUST 14, 1992 ; [ 04/16/02 3:11 PM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,4,6**;APR 03, 1998
+2 ;IHS/CMI/LAB - patch 4 file 200 conversion check
+3 ;IHS/CMI/LAB - patch 2 force stat recs
+4 ;
START ;
+1 ; Set variables like U,DT,DUZ(2) etc.
DO BASICS
+2 ; Make sure Site file has correct fields.
DO CHKSITE
+3 IF APCP("QFLG")
QUIT
+4 ;
+5 ; Do new run initialization.
IF APCPO("RUN")="NEW"
DO ^APCPDRI2
+6 IF $DATA(ZTQUEUED)
QUIT
+7 IF APCP("QFLG")
QUIT
+8 IF APCPO("RUN")="NEW"
DO QUEUE
+9 QUIT
+10 ;
BASICS ; BASIC INITS
+1 DO HOME^%ZIS
SET APCPBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+2 KILL APCP,APCPS,APCPV,APCPT,APCPE
+3 SET APCP("RUN LOCATION")=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
SET APCP("QFLG")=0
+4 ; Allow VISIT lookup with 0 'dependent entry count'.
SET APCDOVRR=1
+5 SET (APCP("INPT"),APCP("CHA"),APCP("APC"),APCP("ERROR COUNT"),APCP("COUNT"),APCP("STAT"),APCP("DEL NEVER SENT"),APCP("DEMO PAT"),APCP("IN NO PP"))=0
+6 QUIT
+7 ;
CHKSITE ;EP
+1 ;S APCPS("PROV FILE")=$S($P(^AUTTSITE(1,0),U,22):200,1:6)
+2 SET APCPS("PROV FILE")=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:200,1:6)
+3 IF '$DATA(^AUTTSITE(1,0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** RPMS SITE FILE has not been set up! ***"
SET APCP("QFLG")=1
QUIT
+4 IF $PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"No ASUFAC for facility in RPMS Site file!!"
SET APCP("QFLG")=1
QUIT
+5 IF $PIECE($GET(^AUTTSITE(1,1)),U,3)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Static ASUFAC for this site is not set up!!"
SET APCP("QFLG")=33
QUIT
+6 IF '$DATA(^APCPSITE(1,0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Site file has not been setup! ***"
SET APCP("QFLG")=1
QUIT
+7 IF $PIECE(^APCPSITE(1,0),U)'=DUZ(2)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** RUN LOCATION not in SITE file!"
SET APCP("QFLG")=2
QUIT
+8 IF '$PIECE(^APCPSITE(1,0),U,3)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** No DELAY value in Site file! ***"
SET APCP("QFLG")=3
+9 IF $PIECE(^APCPSITE(1,0),U,2)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"***No DEFAULT DEVICE value in Site file! ***"
SET APCP("QFLG")=4
+10 IF $PIECE(^APCPSITE(1,0),U,7)="Y"
SET APCPS("APC")=""
+11 IF $PIECE(^APCPSITE(1,0),U,8)="Y"
SET APCPS("INPT")=""
+12 IF $PIECE(^APCPSITE(1,0),U,9)="Y"
SET APCPS("CHA")=""
+13 ;I $P(^APCPSITE(1,0),U,12)="Y" S APCPS("STAT")="" ;IHS/CMI/LAB
+14 SET APCPS("ORYX")=$PIECE(^APCPSITE(1,0),U,13)
+15 ;IHS/CMI/LAB patch 2
SET APCPS("STAT")=""
+16 IF $DATA(APCPS)'=10
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Site file does not contain the type of system for sending transactions!! ****"
SET APCP("QFLG")=5
QUIT
+17 QUIT
QUEUE ;EP
+1 KILL ZTSK
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to QUEUE this to run at a later time"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=1
DO QUEUE1
QUIT
+4 IF APCPO("RUN")="NEW"
IF $DATA(DIRUT)
SET APCP("QFLG")=99
SET DA=APCP("RUN LOG")
SET DIK="^APCPLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 IF APCPO("RUN")="REDO"
IF $DATA(DIRUT)
SET APCP("QFLG")=99
QUIT
+6 QUIT
QUEUE1 ;
+1 SET ZTRTN=$SELECT(APCPO("RUN")="NEW":"DRIVER^APCPDR",1:"EN^APCPREDO")
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="PCC DATA TRANSMISSION"
SET ZTSAVE("APCP*")=""
SET ZTSAVE("APCD*")=""
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")
+5 IF '$DATA(ZTSK)
IF APCPO("RUN")="NEW"
SET APCP("QFLG")=99
SET DA=APCP("RUN LOG")
SET DIK="^APCPLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
QUIT
+6 SET APCPO("QUEUE")=""
+7 SET DIE="^APCPLOG("
SET DA=APCP("RUN LOG")
SET DR=".15///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
