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

APCPSRE.m

Go to the documentation of this file. 
  1. APCPSRE ; IHS/TUCSON/LAB - CMI ; [ 12/16/03  8:07 AM ]
  1.  ;;2.0;IHS PCC DATA EXTRACTION;**6,7**;APR 03, 1998
  1.  ;
  1.  ;
  1.  ;
  1. START ;Begin processing backload
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC(),80),!
  1.  S X="*****  PCC DATA TRANSMISSION SPECIAL RE-EXPORT IN A DATE RANGE  *****" W !,$$CTR(X,80),!
  1.  W !,"ATTENTION:  This option should ONLY be run if you have had",!,"a special request from ORYX or NPIRS to re-send a large amount of previously",!,"exported data."
  1.  W !,"You should use the GEN and REDO options for all regularly scheduled exports.",!!
  1.  S T="INTRO" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END"  W !,X
  1.  K J,X,T
  1.  ;
  1.  S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S APCPJD=X+1
  1.  S APCP("FILENAME")=""
  1.  I $P(^AUTTSITE(1,0),U,21)=1 S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
  1.  I $P(^AUTTSITE(1,0),U,21)'=1 D
  1.  .I ^%ZOSF("OS")["NT" S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD Q
  1.  .S APCP("FILENAME")="BAPC"_$E($P(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
  1.  ;S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
  1.  W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed.  It will be called ",APCP("FILENAME"),!
  1.  I $D(^BAPCDATA) W !!,$C(7),$C(7),"BAPCDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
  1.  I $D(^XTMP("APCPDR")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!  Cannot continue." D XIT Q
  1.  I $D(^XTMP("APCPREDO")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!!  Cannot continue." D XIT Q
  1.  I $D(^XTMP("APCPSRE")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous DATE RANGE EXPORT!!  Cannot continue." D XIT Q
  1. GETDATES ;
  1.  W !,"Please enter the visit date range for which the export should be done.",!
  1. BD ;
  1.  S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  S APCP("RUN BEGIN")=Y
  1. ED ;
  1.  S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date:  " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  I Y<APCP("RUN BEGIN") W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S APCP("RUN END")=Y
  1.  S X1=APCP("RUN BEGIN"),X2=-1 D C^%DTC S APCPSD=X
  1.  S APCPERR=0
  1.  D CHECK
  1.  I $G(APCPERR) W !!,"Goodbye",! D XIT Q
  1.  W !!,"A Log entry will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCP("RUN BEGIN"))," to ",$$FMTE^XLFDT(APCP("RUN END")),".",!
  1. CONT ;continue or not
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"Goodbye" D XIT Q
  1.  I 'Y W !!,"Goodbye" D XIT Q
  1.  S APCPO("RUN")="DATE",APCPERR=0
  1.  D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
  1.  K APCPS,APCPV,APCPT,APCPE
  1.  S APCP("RUN LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,10),APCP("QFLG")=0
  1.  S APCDOVRR=1 ; Allow VISIT lookup with 0 'dependent entry count'.
  1.  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
  1.  D CHKSITE^APCPDRI
  1.  I $G(APCP("QFLG")) W !!,"Exiting.." D XIT Q
  1.  D GENLOG ;generate new log entry
  1.  I 'APCP("RUN LOG") Q
  1.  D QUEUE
  1.  I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
  1.  I $D(APCP("QUEUE")) D XIT Q
  1.  ;
  1. PROCESS ;EP - process new run
  1.  S APCPCNT=$S('$D(ZTQUEUED):"X APCPCNT1  X APCPCNT2",1:"S APCPCNTR=APCPCNTR+1"),APCPCNT1="F APCPCNTL=1:1:$L(APCPCNTR)+1 W @APCPBS",APCPCNT2="S APCPCNTR=APCPCNTR+1 W APCPCNTR,"")"""
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting visits.  (1)"
  1.  S APCPSD=APCPSD_".9999"
  1.  ;set counters
  1.  S (APCPCNTR,APCPTERR,APCPTOTR,APCPUSED)=0
  1.  D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
  1.  S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.15///R"_";.03////"_APCP("RUN START") D ^DIE K DA,DIE,DR
  1. V ; Run by visit date
  1.  F  S APCPSD=$O(^AUPNVSIT("B",APCPSD)) Q:APCPSD=""!((APCPSD\1)>APCP("RUN END"))  D V1
  1.  D ^APCPLOG
  1.  D PURGE
  1.  D EN^APCPTAPE
  1.  D XIT
  1.  Q
  1. V1 ;go through each visit on this date
  1.  S APCP("V DFN")="" F  S APCP("V DFN")=$O(^AUPNVSIT("B",APCPSD,APCP("V DFN"))) Q:APCP("V DFN")'=+APCP("V DFN")  I $D(^AUPNVSIT(APCP("V DFN"),0)) S APCP("V REC")=^(0) D PROC
  1.  Q
  1. PROC ;
  1.  K APCPT,APCPV,APCPE
  1.  D KILL^AUPNPAT
  1.  Q:$D(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
  1.  S APCPV("TX GENERATED")=0,APCPV("STAT TX GEN")=0
  1.  X APCPCNT
  1.  I $P($G(^AUPNVSIT(APCP("V DFN"),11)),U,4)="" S $P(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
  1.  S APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
  1.  S APCPV("V DATE")=+APCPV("V REC")\1
  1.  D ^APCPDR2
  1.  S:'$D(^APCPLOG(APCP("RUN LOG"),21,0)) ^APCPLOG(APCP("RUN LOG"),21,0)="^9001005.2101PA^^"
  1.  S ^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN"),0)=APCP("V DFN")_U_APCPV("TX GENERATED")_U_APCPV("DEP COUNT")_U_APCPV("TYPE")_U_APCPV("TX GENERATED")_U_U_APCPV("STAT TX GEN")
  1.  S $P(^APCPLOG(APCP("RUN LOG"),21,0),U,3)=APCP("V DFN"),$P(^(0),U,4)=$P(^(0),U,4)+1
  1.  K DIE,DR,DIC
  1.  Q
  1. PURGE ; PURGE SET .14 FIELD
  1.  W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
  1.  S APCPCNTR=0,APCPV("V DFN")=0 ;IHS/CMI/LAB patch 2 set to 0
  1.  F  S APCPV("V DFN")=$O(^XTMP("APCPSRE","MAIN TX",APCPV("V DFN"))) Q:APCPV("V DFN")'=+APCPV("V DFN")  D PURGE2
  1.  K ^XTMP("APCPSRE")
  1.  Q
  1. PURGE2 ;
  1.  S DIE="^AUPNVSIT(",DA=APCPV("V DFN"),DR=".14///"_^XTMP("APCPSRE","MAIN TX",APCPV("V DFN")) D ^DIE K DA,DIE,DR
  1.  X APCPCNT
  1.  Q
  1.  ;
  1. CHECK ;
  1.  Q
  1. QUEUE ;EP
  1.  K ZTSK
  1.  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
  1.  I Y=1 D QUEUE1 Q
  1.  I APCPO("RUN")="NEW",$D(DIRUT) S APCPERR=1 S DA=APCPLOG,DIK="^APCPLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
  1.  I APCPO("RUN")="REDO",$D(DIRUT) S APCPERR=1 Q
  1.  Q
  1. QUEUE1 ;
  1.  S ZTRTN="PROCESS^APCPSRE"
  1.  S ZTIO="",ZTDTH="",ZTDESC="DATA TRANS BACKLOAD" S ZTSAVE("APCP*")=""
  1.  D ^%ZTLOAD
  1.  W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
  1.  I '$D(ZTSK),APCPO("RUN")="NEW" S APCPERR=1 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
  1.  S APCP("QUEUE")=""
  1.  S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
  1.  K ZTSK
  1.  Q
  1. GENLOG ; GENERATE NEW LOG ENTRY
  1.  W:'$D(ZTQUEUED) !,"Generating New Log entry.."
  1.  S Y=APCP("RUN BEGIN") X ^DD("DD") S X=""""_Y_"""",DIC="^APCPLOG(",DIC(0)="L",DLAYGO=9001005,DIC("DR")=".02////"_APCP("RUN END")_";.09///`"_DUZ(2)_";.27///1"
  1.  D ^DIC K DIC,DLAYGO,DR
  1.  I Y<0 W !!,"Error generating log entry" D XIT Q
  1.  S APCP("RUN LOG")=+Y
  1.  K ^BAPCDATA ;KILLS OKAY PER CMB STANDARDS FOR TRANSMITTING DATA TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
  1.  W "Log entry is ",APCP("RUN LOG")
  1.  Q
  1. XIT ;exit, eoj cleanup
  1.  D EOP
  1.  D ^XBFMK
  1.  D EN^XBVK("APCP")
  1.  D KILL^AUPNPAT
  1.  K APCDOVRR
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of Job.  Press Return.",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
  1.  I $G(D)="" Q ""
  1.  Q $E(D,1,3)+1700_$E(D,4,7)
  1.  ;
  1.  ;
  1. INTRO ;introductory text
  1.  ;;This program will generate statistical records for a visit
  1.  ;;date range that you enter.  A log entry will be created which will log
  1.  ;;the number of visits processed and the number of statistical records
  1.  ;;generated.  
  1.  ;;
  1.  ;;END