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

ACDVIMP1.m

Go to the documentation of this file. 
  1. ACDVIMP1 ;IHS/ADC/EDE/KML - BUILD CDMIS ENTRIES FROM IMPORTED GLOBAL; 
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;;
  1.  ;******************************************************************
  1.  ;Build CDMIS data files on area/HQ machine from the ^ACDVTMP global
  1.  ;that has just been imported to the area/HQ machine
  1.  ;****************************************************************
  1. EN ;EP
  1.  ;//^ACDVIMP
  1.  ;Check for existence of data
  1.  I '$D(^ACDVTMP) W !,"No data to import..." Q
  1.  ;
  1.  ;Validate incomming ASUFAC's are in the area location file
  1.  ;ACDUSER is in the form 'DUZ(2)^PROGRAM ASSOCIATED WITH VISIT'
  1.  ;Phoenix may have several programs in their database because they
  1.  ;will have outlying facilities dialing in to use CDMIS.
  1.  ;
  1.  W !! K ACDQUIT S ACDUSER="" F  S ACDUSER=$O(^ACDVTMP(ACDUSER)) Q:ACDUSER=""  W !,"Checking for the existence of ASUFAC: ",$P(ACDUSER,"*",2)," in your location file." I '$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0)) S ACDQUIT=1 W *7," Missing.",!
  1.  I $D(ACDQUIT) W !!,"Aborted...Contact your site manager immediately.." S ^ACDV1TMP=1 Q
  1.  E  W !!,"All facility codes exist. Proceeding with rebuild...",!
  1.  ;
  1.  S ACDUSER="" F  S ACDUSER=$O(^ACDVTMP(ACDUSER)) Q:ACDUSER=""  F ACDV=0:0 S ACDV=$O(^ACDVTMP(ACDUSER,ACDV)) Q:'ACDV  D:$D(^(ACDV,"P")) L I $D(^ACDVTMP(ACDUSER,ACDV,"V")) S ACD("V")=^("V") D FILEV,L W "."
  1.  I $D(^ACDV1TMP) W !!,"Since this import is finished, now killing the ^ACDV1TMP global flag." K ^ACDV1TMP ;       kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)
  1.  Q
  1. L ;Get data from link files
  1.  I $D(^ACDVTMP(ACDUSER,ACDV,"P")) D P Q
  1.  I $D(^ACDVTMP(ACDUSER,ACDV,"IIF")) D IIF Q
  1.  I $D(^ACDVTMP(ACDUSER,ACDV,"TDC")) D TDC Q
  1.  I $D(^ACDVTMP(ACDUSER,ACDV,"CS")) D CS Q
  1.  Q
  1. IIF ;Get entry to file into ^ACDIIF
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)) Q:'ACDDA  S ACD("IIF")=^(ACDDA) D FILEIIF
  1.  Q
  1. TDC ;Get entry to file into ^ACDTDC
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)) Q:'ACDDA  S ACD("TDC")=^(ACDDA) D FILETDC
  1.  Q
  1. CS ;Get entry to file into ^ACDCS
  1.  F ACDDA=0:0 S ACDDA=$O(^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)) Q:'ACDDA  S ACD("CS")=^(ACDDA) D FILECS
  1.  Q
  1. P ;Get entry to file into ^ACDPD
  1.  S ACD("P")=^ACDVTMP(ACDUSER,ACDV,"P") D FILEP
  1.  Q
  1. FILEIIF ;File entry into ^ACDIIF
  1.  S DIC="^ACDIIF(",X=$P(ACD("IIF"),U),DIC(0)="L" D FILE^ACDFMC
  1.  S ^ACDIIF(+Y,0)=ACD("IIF"),^("BWP")=ACDBWP
  1.  S ACDIIF=+Y
  1.  F ACDMULT=2,3 F ACDMLEV=0:0 S ACDMLEV=$O(^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,$S(ACDMULT=2:"DRUG",1:"SECPROB"),ACDMLEV)) Q:'ACDMLEV  D
  1.  .S DA(1)=ACDIIF,DIC="^ACDIIF("_DA(1)_","_ACDMULT_",",DIC(0)="L",X=ACDMLEV S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002170."_$S(ACDMULT=2:"05",1:"01")_"PA" D FILE^ACDFMC
  1.  .K ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA,$S(ACDMULT=2:"DRUG",1:"SECPROB"),ACDMLEV)
  1.  S DA=ACDIIF,DIK="^ACDIIF(" D IX1^DIK
  1.  K ^ACDVTMP(ACDUSER,ACDV,"IIF",ACDDA)
  1.  Q
  1. FILETDC ;File entry into ^ACDTDC
  1.  S DIC="^ACDTDC(",X=$P(ACD("TDC"),U),DIC(0)="L" D FILE^ACDFMC
  1.  S ^ACDTDC(+Y,0)=ACD("TDC"),^("BWP")=ACDBWP
  1.  S ACDTDC=+Y
  1.  F ACDMULT=2,3 F ACDMLEV=0:0 S ACDMLEV=$O(^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,$S(ACDMULT=2:"DRUG",1:"SECPROB"),ACDMLEV)) Q:'ACDMLEV  D
  1.  .S DA(1)=ACDTDC,DIC="^ACDTDC("_DA(1)_","_ACDMULT_",",DIC(0)="L",X=ACDMLEV S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002171."_$S(ACDMULT=2:"02",1:"0102")_"PA" D FILE^ACDFMC
  1.  .K ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA,$S(ACDMULT=2:"DRUG",1:"SECPROB"),ACDMLEV)
  1.  S DA=ACDTDC,DIK="^ACDTDC(" D IX1^DIK
  1.  K ^ACDVTMP(ACDUSER,ACDV,"TDC",ACDDA)
  1.  Q
  1. FILECS ;File entry into ^ACDCS
  1.  S DIC="^ACDCS(",X=$P(ACD("CS"),U),DIC(0)="L" D FILE^ACDFMC
  1.  S ^ACDCS(+Y,0)=ACD("CS"),^("BWP")=ACDBWP
  1.  S ACDCS=+Y
  1.  K ^ACDVTMP(ACDUSER,ACDV,"CS",ACDDA)
  1.  S DA=ACDCS,DIK="^ACDCS(" D IX1^DIK
  1.  Q
  1. FILEV ;File visit into ^ACDVIS
  1.  S DIC="^ACDVIS(",X=$P(ACD("V"),U),DIC(0)="L" D FILE^ACDFMC
  1.  S ^ACDVIS(+Y,0)=ACD("V")
  1.  S ACDBWP=+Y
  1.  S ACDPG=$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0))
  1.  I '$D(^ACDF5PI(ACDPG,0)) S DIC="^ACDF5PI(",DIC(0)="L",X=ACDPG,DINUM=X D FILE^ACDFMC
  1.  S DIE="^ACDVIS(",DA=ACDBWP,DR="99.99///^S X=ACDPG" D DIE^ACDFMC
  1.  S DA=ACDBWP,DIK="^ACDVIS(" D IX1^DIK
  1.  K ^ACDVTMP(ACDUSER,ACDV,"V")
  1.  Q
  1. FILEP ;File entry into ^ACDPD
  1.  S DIC="^ACDPD(",X=$P(ACD("P"),U),DIC(0)="L" D FILE^ACDFMC
  1.  S ^ACDPD(+Y,0)=ACD("P")
  1.  S ACDP=+Y
  1.  S ACDPG=$O(^AUTTLOC("C",$P(ACDUSER,"*",2),0))
  1.  I '$D(^ACDF5PI(ACDPG,0)) S DIC="^ACDF5PI(",DIC(0)="L",X=ACDPG,DINUM=X D FILE^ACDFMC
  1.  S DIE="^ACDPD(",DA=ACDP,DR="3///^S X=ACDPG" D DIE^ACDFMC
  1.  F ACDAY=0:0 S ACDAY=$O(^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)) Q:'ACDAY  S ACD("P")=^(ACDAY) D
  1.  .S DA(1)=ACDP,DIC="^ACDPD("_DA(1)_",1,",DIC(0)="L",X=ACDAY S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002170.75A" D FILE^ACDFMC S ^ACDPD(ACDP,1,+Y,0)=ACD("P")
  1.  .K ^ACDVTMP(ACDUSER,ACDV,"P","DAY",ACDAY)
  1.  S DA=ACDP,DIK="^ACDPD(" D IX1^DIK
  1.  K ^ACDVTMP(ACDUSER,ACDV,"P")
  1.  Q