Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCPSR

APCPSR.m

Go to the documentation of this file.
APCPSR ; IHS/TUCSON/LAB - PCC Operational Summary AUGUST 14, 1992 ; [ 08/17/03  8:19 PM ]
 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,6**;APR 03, 1998
 ;IHS/CMI/LAB - changed TMP to XTMP
 ;
START ;
 W:$D(IOF) @IOF
 W !,"**********          PCC DATA TRANSMISSION SUMMARY REPORT          **********",!
 W !!,"This report presents a summary of data for a single PCC Data Transmission",!,"Log entry.",!!
LOG ;
 S APCPSR("LOG")=""
 K DIC S DIC="^APCPLOG(",DIC(0)="AEQM" D ^DIC I Y<0 G XIT
 S APCPSR("LOG")=+Y
 I '$D(^APCPLOG(APCPSR("LOG"),21)) W !!,"Visit data has already been purged!!" G LOG
 S X=^APCPLOG(APCPSR("LOG"),0),APCPSR("RUN BEGIN")=$P(X,U),APCPSR("RUN END")=$P(X,U,2),APCPSR("COUNT")=$P(X,U,6),APCPSR("ORIG TX DATE")=$P($P(X,U,3),".")
 S Y=APCPSR("RUN BEGIN") X ^DD("DD") S APCPSR("PRINT BEGIN")=Y
 S Y=APCPSR("RUN END") X ^DD("DD") S APCPSR("PRINT END")=Y
 S APCPSR("VISITS")=$P(^APCPLOG(APCPSR("LOG"),21,0),U,4)
 W !!,"Log entry ",APCPSR("LOG"),", was for date range ",APCPSR("PRINT BEGIN")," through",!,APCPSR("PRINT END")," and generated ",APCPSR("COUNT")," transactions from ",APCPSR("VISITS")," visits.",!!
 ;S DIC="^DIC(40.7,",X=39,DIC(0)="",D="C" D MIX^DIC1 I Y=-1 W !,$C(7),$C(7),"CAN'T FIND PHARMACY CLINIC IN CLINIC STOP FILE" D XIT Q
 ;S APCPSR("PHARM NAME")=$P(Y,U,2)
 S Y=DT D DD^%DT S APCPSR("DTP")=Y
ZIS ;call to XBDBQUE
 S XBRP="PRINT^APCPSR",XBRC="PROCESS^APCPSR",XBRX="XIT^APCPSR",XBNS="APCP"
 D ^XBDBQUE
 D XIT
 Q
PROCESS ; Entry point for Taskman
 S APCPJOB=$J,APCPBTH=$H
 K ^XTMP("APCPSR",APCPJOB,APCPBTH),^XTMP("APCPSRP",APCPJOB,APCPBTH)
 S ^XTMP("APCPSR",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC DATA TX SUM REPORT"
 S APCPSR("BT")=$H
 D CHKSITE^APCPDRI
 S APCDOVRR=1,APCPSR="APCPSR"
 D V^APCPSR1
 D SET^APCPSR11
 S APCPSR("ET")=$H
 Q
PRINT ;EP
 D ^APCPSRP
 K ^XTMP("APCPSR",APCPJOB,APCPBTH),^XTMP("APCPSRP",APCPJOB,APCPBTH)
 Q
XIT ;
 K DA,DIE,DIC,POP,DIR
 K APCPSR,APCPS,APCDOVRR,APCPVAR,APCPJOB,APCPBTH
 Q