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

APCPREX.m

Go to the documentation of this file. 
  1. APCPREX ; IHS/TUCSON/LAB - CMI ; [ 08/18/2003   7:44 AM ]
  1.  ;;2.0;IHS PCC DATA EXTRACTION;**3,6**;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 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.  W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed.  It will be called OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
  1.  I $D(^APCPDATA) W !!,$C(7),$C(7),"APCPDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
  1. GETDATES ;
  1.  W !,"Please enter the date range for which the statistical (ORYX) records",!,"should be generated.",!
  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 APCPBD=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<APCPBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S APCPED=Y
  1.  S X1=APCPBD,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 !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED),".",!
  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 APCPRUN="NEW",APCPERR=0
  1.  D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
  1.  D GENLOG ;generate new log entry
  1.  I $G(APCPERR) D XIT Q
  1.  D QUEUE
  1.  I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
  1.  I $D(APCPQUE) D XIT Q
  1.  ;
  1. PROCESS ;EP - process new run
  1.  S APCPCNT=$S('$D(ZTQUEUED):"X APCPCNT1  X APCPCNT2",1:"S APCPTOTV=APCPTOTV+1"),APCPCNT1="F APCPCNTL=1:1:$L(APCPTOTV)+1 W @APCPBS",APCPCNT2="S APCPTOTV=APCPTOTV+1 W APCPTOTV,"")"""
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting visits.  (1)"
  1.  K ^APCPDATA
  1.  S APCPSD=APCPSD_".9999"
  1.  ;set counters
  1.  S (APCPTOTV,APCPTERR,APCPTOTR,APCPUSED)=0
  1. V ; Run by visit date
  1.  F  S APCPSD=$O(^AUPNVSIT("B",APCPSD)) Q:APCPSD=""!((APCPSD\1)>APCPED)  D V1
  1.  S DA=APCPLOG,DIE="^APCPREX(",DR=".05///"_APCPTOTV_";.06///"_APCPUSED_";.07///"_APCPTOTR_";.08///P" D ^DIE K DIE,DA,DR ;no error check
  1.  S ^APCPREX(APCPLOG,11,0)="^9001005.41A^0^0"
  1.  S X="",C=0 F  S X=$O(APCPERRT(X)) Q:X=""  S C=C+1,^APCPREX(APCPLOG,11,C,0)=X_"^"_APCPERRT(X)
  1.  S DA=APCPLOG,DIK="^APCPREX(" D IX1^DIK K DA,DIK
  1.  D WRITEF
  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 APCPVREC=^(0) D PROC
  1.  Q
  1. PROC ;
  1.  X APCPCNT
  1.  I '$P(APCPVREC,U,9) S APCPERRT("ZERO DEP ENTRIES")=$G(APCPERRT("ZERO DEP ENTRIES"))+1 Q  ;no dependent entries
  1.  I $P(APCPVREC,U,11) S APCPERRT("DELETED VISIT")=$G(APCPERRT("DELETED VISIT"))+1 Q
  1.  I $P(APCPVREC,U,23)=.5 Q  ;MFI CREATED VISIT
  1.  S APCPV("SRV CAT")=$P(APCPVREC,U,7),APCPV("TYPE")=$P(APCPVREC,U,3)
  1.  S DFN=$P(APCPVREC,U,5)
  1.  I 'DFN S APCPERRT("NO PATIENT")=$G(APCPERRT("NO PATIENT"))+1 Q
  1.  I $P(^DPT(DFN,0),U)["DEMO,PATIENT" S APCPERRT("DEMO PATIENT")=$G(APCPERRT("DEMO PATIENT"))+1 Q
  1.  I '$D(^AUPNVPOV("AD",APCP("V DFN"))),"EI"'[APCPV("SRV CAT") S APCPERRT("NO POV")=$G(APCPERRT("NO POV"))+1 Q
  1.  I $$PRIMPROV^APCLV(APCP("V DFN"),"I")="","EI"'[APCPV("SRV CAT") S APCPERRT("NO PRIM PROV")=$G(APCPERRT("NO PRIM PROV"))+1 Q  ;no primary provider
  1.  I APCPV("SRV CAT")="H","CVO"'[APCPV("TYPE") D  Q:'Y
  1.  .S Y=0 S Z=$O(^AUPNVINP("AD",APCP("V DFN"),0))
  1.  .I 'Z S APCPERRT("NO V HOSP")=$G(APCPERRT("NO V HOSP"))+1 Q
  1.  .I $P($G(^AUPNVINP(Z,0)),U,15) S APCPERRT("HOSP VISIT NOT CODED")=$G(APCPERRT("HOSP VISIT NOT CODED"))+1 Q
  1.  .S Y=1
  1.  .Q
  1. GENREC ;generate record
  1.  D GENREC^APCPREX2
  1.  Q
  1. CHECK ;
  1.  Q
  1. RERUN ;EP - rerun old log entry
  1.  W:$D(IOF) @IOF
  1.  W !!,"Rerun DATA TRANSMISSION Backload Visit Set",!
  1.  ;GET LOG
  1.  S DIC="^APCPREX(",DIC(0)="AEMQ" D ^DIC
  1.  K DIC,DA,DD,DO,D0
  1.  I Y=-1 D XIT Q
  1.  S APCPLOG=+Y
  1.  S APCPBD=$P(^APCPREX(APCPLOG,0),U,3),APCPED=$P(^(0),U,4),APCPSD=$$FMADD^XLFDT(APCPBD,-1),APCPRUN="REDO"
  1.  S APCP0=^APCPREX(APCPLOG,0)
  1.  W !!,"Log entry ",APCPLOG," will be reprocessed.  Visits in the date range ",!,$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED)," will be processed.",!
  1.  W !,"The output file created will be called OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG
  1.  W !,"The last time a total of ",$P(APCP0,U,5)," visits were processed, of which, ",!,$P(APCP0,U,6)," generated statistical records.",!!
  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.  D QUEUE
  1.  I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
  1.  I $D(APCPQUE) D XIT Q
  1.  ;
  1. RERUN1 ;
  1.  ;reset log entry
  1.  F X=5,6,7 S $P(^APCPREX(APCPLOG,0),U,X)=""
  1.  K ^APCPREX(APCPLOG,11) ;kill error multiple
  1.  S DA=APCPLOG,DIE="^APCPREX(",DR=".02///"_DT D ^DIE K DIE,DR,DA
  1.  S APCPRUN="REDO",APCPERR=0
  1.  D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
  1.  G PROCESS
  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 APCPRUN="NEW",$D(DIRUT) S APCPERR=1 S DA=APCPLOG,DIK="^APCPREX(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
  1.  I APCPRUN="REDO",$D(DIRUT) S APCPERR=1 Q
  1.  Q
  1. QUEUE1 ;
  1.  S ZTRTN=$S(APCPRUN="NEW":"PROCESS^APCPREX",1:"RERUN1^APCPREX")
  1.  S ZTIO="",ZTDTH="",ZTDESC="ORYX BACKLOAD" S ZTSAVE("APCP*")=""
  1.  D ^%ZTLOAD
  1.  W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
  1.  I '$D(ZTSK),APCPRUN="NEW" S APCPERR=1 S DA=APCPLOG,DIK="^APCPREX(" 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 APCPQUE=""
  1.  S DIE="^APCPREX(",DA=APCPLOG,DR=".15///Q" D ^DIE K DIE,DA,DR
  1.  K ZTSK
  1.  Q
  1. WRITEF ;EP - write out flat file
  1.  I '$D(^APCPDATA)!(APCPTOTR=0) W:'$D(ZTQUEUED) !!,"No transactions to send in that date range.",! Q
  1.  S XBGL="APCPDATA"
  1.  S ^APCPDATA(0)=$P(^AUTTLOC(DUZ(2),0),U,10)_"^"_$P(^DIC(4,DUZ(2),0),U)_"^"_$$DATE($E(DT,1,7))_"^"_$$DATE(APCPBD)_"^"_$$DATE(APCPED)_"^^"_APCPTOTR_"^^" ;IHS/CMI/LAB - new date format
  1.  S XBMED="F",XBFN="OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG,XBTLE="SAVE OF SDB BACKLOAD RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
  1.  S XBF="",XBQ="N"
  1.  D ^XBGSAVE
  1.  ;check for error
  1.  I XBFLG=-1 S APCPERR=1 W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) Q
  1.  K ^APCPDATA
  1.  S DA=APCPLOG,DIE="^APCPREX(",DR=".08///S;.11////OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG D ^DIE K DA,DIE,DR
  1.  K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
  1.  Q
  1. GENLOG ;generate new log entry
  1.  W:'$D(ZTQUEUED) !,"Generating New Log entry.."
  1.  S Y=$$NLOG S X=""""_Y_"""",DIC="^APCPREX(",DIC(0)="L",DLAYGO=9001005.4,DIC("DR")=".02////"_DT_";.03////"_APCPBD_";.04////"_APCPED_";.09///`"_DUZ(2)
  1.  D ^DIC K DIC,DLAYGO,DR
  1.  I Y<0 W !!,$C(7),$C(7),"Error creating log entry." S APCPERR=1 Q
  1.  S APCPLOG=+Y
  1.  Q
  1. XIT ;exit, eoj cleanup
  1.  D EOP
  1.  D ^XBFMK
  1.  D EN^XBVK("APCP")
  1.  D KILL^AUPNPAT
  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. NLOG() ;get next log
  1.  NEW X,L S (X,L)=0 F  S X=$O(^APCPREX(X)) Q:X'=+X  S L=X
  1.  Q L+1
  1. INTRO ;introductory text
  1.  ;;This program will generate statistical records (ORYX 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