- 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
