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

ACDVSAVE.m

Go to the documentation of this file. 
  1. ACDVSAVE ;IHS/ADC/EDE/KML - EXTRACT VISIT DATA; 
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1.  ;
  1. EN ;EP
  1.  ;//[ACD RE-EXT]
  1.  ;Options locked
  1.  D EN^ACDGLOCK
  1.  ;
  1.  ;Chk for incomplete import.
  1.  I $D(^ACDV1TMP) W !!,*7,*7,"Data still exists in the ^ACDV1TMP global due to a",!,"CORRUPT LOCATION FILE.  * I MUST STOP *" D K Q
  1.  ;
  1.  ;
  1.  I $D(^ACDVTMP) W !!,*7,*7,"An extract is presently running." D K Q
  1.  K ^ACDVTMP ;       kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)
  1.  ;
  1.  W !!,*7,*7,"Once a CDMIS DATA RECORD is extracted,",!,"the record may NOT be 'DELETED' or 'EDITED'."
  1.  ;
  1.  D EN1^ACDV4MES
  1.  I $E(ACD6DIG)="9" W !!,"OK, Headquarters is Archiving",!!,"Be sure to delete the data when the archive is finished."
  1.  ;
  1. D ;Ask start/stop date
  1.  K ACDQUIT D D^ACDWRQ I $D(ACDQUIT) D K Q
  1.  S ACDDTF=ACDFR,ACDDTT=ACDTO
  1.  ;
  1.  W !!,"Extracting all CDMIS visit/prevention data",!,"from: ",$$DD^ACDFUNC(ACDFR)," through: ",$$DD^ACDFUNC(ACDTO)
  1.  ;
  1.  ;
  1. T ;Ask transmission mode
  1.  ; commented out net mail option per Wilbur Woodis
  1.  ;K ACDMAIL S DIR(0)="S^1:TRANSMIT DATA VIA HOST OS FILE;2:TRANSMIT DATA VIA NET MAIL" D ^DIR G:X["^"!($D(DTOUT)!(X="")) K
  1.  ;I Y=2 S ACDMAIL=1 D
  1.  ;.I '$O(^ACDOMAIN(DUZ(2),1,0)) W !!,*7,*7,"You must set domains to send extracted data to." D EN^ACDSRV3
  1.  ;.S ACDSRVOP=2 D DOM^ACDSRV3 I '$D(XMY) W !!,*7,*7,"No domains are defined to send the extraction data to.",!,"I cannot continue because of this." S ACDQUIT=1
  1.  ;I $D(ACDQUIT) D K Q
  1.  F  W !!,"OK to continue" S %=2 D YN^DICN W:%=0 "  Answer Yes or No" G:%'=1&(%'=0) K Q:%=1
  1.  ;
  1.  ;Clean up incomplete entries prior to extracting data.
  1.  D EN^ACDCLN
  1.  ;
  1.  ;Get backfilled data to export
  1.  S X1=ACDFR,X2=-600 D C^%DTC S ACDFR=X
  1.  ;
  1.  W !!,"Looking for visit data to extract....."
  1.  ;
  1. VIS ;Get visits
  1.  F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO)  F ACDV=0:0 S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV  D V D:ACDVHIT L W "."
  1.  D CLN
  1.  ;
  1.  ;Get preventions
  1.  W !!,"Looking for prevention data to extract....."
  1.  F ACD=ACDFR-.01:0 S ACD=$O(^ACDPD("B",ACD)) Q:'ACD!(ACD>ACDTO)  F ACDV=0:0 S ACDV=$O(^ACDPD("B",ACD,ACDV)) Q:'ACDV  I $D(^ACDPD(ACDV,0)) D P
  1.  ;
  1.  ;Create host file
  1.  I '$D(^ACDVTMP) W !!,"No new data found." G K
  1.  I '$D(ACDMAIL) S XBGL="ACDVTMP",$P(^ACDVTMP(0),U)=ACDDTT,$P(^(0),U,2)=ACDDTF,$P(^(0),U,20)="IMPORT FILE" D ^ACDGX5
  1.  ;Use net mail
  1.  I $D(ACDMAIL) D ^ACDVSRV0
  1.  ;
  1.  W !!,"Now deleting the ^ACDVTMP global....."
  1.  K ^ACDVTMP ;       kill of scratch global  SAC EXEMPTION (2.3.2.3  KILLING of unsubscripted globals is prohibited)
  1.  W !,"CDMIS data extraction successfully completed."
  1.  D PAUSE^ACDDEU
  1.  G K
  1.  ;
  1. L ;Get visit link file
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDIIF("C",ACDV,ACDDA)) Q:'ACDDA  I $D(^ACDIIF(ACDDA,0)) D IIF
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDTDC("C",ACDV,ACDDA)) Q:'ACDDA  I $D(^ACDTDC(ACDDA,0)) D TDC
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDCS("C",ACDV,ACDDA)) Q:'ACDDA  I $D(^ACDCS(ACDDA,0)) D CS
  1.  Q
  1.  ;
  1. IIF ;Bld node
  1.  I $P(^ACDIIF(ACDDA,0),U,25) Q
  1.  I '$D(^ACDVTMP(ACDUSER,ACDV,"V")) Q
  1.  S ACD("IIF")=^ACDIIF(ACDDA,0)
  1.  S ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)=ACD("IIF")
  1.  F ACDRUG=0:0 S ACDRUG=$O(^ACDIIF(ACDDA,2,ACDRUG)) Q:'ACDRUG  I $D(^(ACDRUG,0)) S ACDPOINT=^(0) S ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"DRUG",ACDPOINT)=ACDPOINT
  1.  F ACDSCND=0:0 S ACDSCND=$O(^ACDIIF(ACDDA,3,ACDSCND)) Q:'ACDSCND  I $D(^(ACDSCND,0)) S ACDPOINT=^(0) S ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,"SECPROB",ACDPOINT)=ACDPOINT
  1.  S DIE="^ACDIIF(",DA=ACDDA,DR="25///T" D DIE^ACDFMC
  1.  Q
  1. TDC ;Bld node
  1.  I $P(^ACDTDC(ACDDA,0),U,25) Q
  1.  I '$D(^ACDVTMP(ACDUSER,ACDV,"V")) Q
  1.  S ACD("TDC")=^ACDTDC(ACDDA,0)
  1.  S ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)=ACD("TDC")
  1.  F ACDRUG=0:0 S ACDRUG=$O(^ACDTDC(ACDDA,2,ACDRUG)) Q:'ACDRUG  I $D(^(ACDRUG,0)) S ACDPOINT=^(0) S ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"DRUG",ACDPOINT)=ACDPOINT
  1.  F ACDSCND=0:0 S ACDSCND=$O(^ACDTDC(ACDDA,3,ACDSCND)) Q:'ACDSCND  I $D(^(ACDSCND,0)) S ACDPOINT=^(0) S ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,"SECPROB",ACDPOINT)=ACDPOINT
  1.  S DIE="^ACDTDC(",DA=ACDDA,DR="25///T" D DIE^ACDFMC
  1.  Q
  1. CS ;Bld node
  1.  I $P(^ACDCS(ACDDA,0),U,5) Q
  1.  I '$D(^ACDVTMP(ACDUSER,ACDV,"V")) Q
  1.  S ACD("CS")=^ACDCS(ACDDA,0)
  1.  S ^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)=ACD("CS")
  1.  S DIE="^ACDCS(",DA=ACDDA,DR="5///T" D DIE^ACDFMC
  1.  Q
  1. P ;Bld node
  1.  S ACD("P")=^ACDPD(ACDV,0)
  1.  Q:ACDPGM'=$P(ACD("P"),U,4)  ;  quit if not signon site
  1.  ;S ACDBWP=$P(ACD("P"),U,4),ACDBWP=$P(^ACDF5PI(ACDBWP,0),U),ACDBWP=$P(^AUTTLOC(ACDBWP,0),U),ACD6PGM=$P(^AUTTLOC(ACDBWP,0),U,10)
  1.  S ACDBWP=$P(ACD("P"),U,4),ACDBWP=$P(^AUTTLOC(ACDBWP,0),U),ACD6PGM=$P(^AUTTLOC(ACDBWP,0),U,10)
  1.  S ACDUSER=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)_"*"_ACD6PGM
  1.  I $P(^ACDPD(ACDV,0),U,25) Q
  1.  S ^ACDVTMP(ACDUSER,ACDV,"P")=ACD("P")
  1.  F ACDAY=0:0 S ACDAY=$O(^ACDPD(ACDV,1,ACDAY)) Q:'ACDAY  I $D(^(ACDAY,0)) S ACD("P")=^(0),^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)=ACD("P")
  1.  S DIE="^ACDPD(",DA=ACDV,DR="25///T" D DIE^ACDFMC
  1.  W "."
  1.  Q
  1. V ;V node
  1.  D V^ACDVSAV2
  1.  Q
  1. CLN ;Make pass to clean incomplete entries
  1.  D CLN^ACDVSAV2
  1.  Q
  1. K ;
  1.  ;Unlock options
  1.  D EN1^ACDGLOCK
  1.  K ACDDTF,ACDDTT
  1.  K ACDV,ACDUSER,ACDBWP,ACDDA,ACDFR,ACDTO,ACD,ACDDRUG,ACD6PGM,ACDRUG,ACDTIME,ACDPOINT
  1.  K ACDSCND ;          3-31-95 EDE
  1.  Q