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

ADGGFL.m

Go to the documentation of this file. 
  1. ADGGFL ;searhc/maw - ADG CONVERT V HOSP FILE POINTERS  [ 05/13/1999  2:45 PM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**1**;MAY 04, 1999
  1.  ;
  1.  ;this routine will go through the admission type file and the
  1.  ;discharge type files and get their corresponding entries with
  1.  ;the new facility movement file
  1.  ;
  1. MAIN ;-- this is the main routine driver
  1.  D ADT,DIT
  1.  D GET Q:POP
  1.  D SET,END
  1.  Q
  1.  ;
  1. ADT ;-- this is where i get the admission iens
  1.  W !!,"I am getting the new admission type pointers"
  1.  S FMNM=0 F  S FMNM=$O(^DIC(42.1,"B",FMNM)) Q:FMNM=""  D
  1.  . S FMIEN=0 F  S FMIEN=$O(^DIC(42.1,"B",FMNM,FMIEN)) Q:FMIEN=""  D
  1.  .. Q:'$D(^DG(405.1,"B",FMNM))
  1.  .. S ADT(FMIEN)=$O(^DG(405.1,"B",FMNM,0))
  1.  .. W "."
  1.  Q
  1.  ;
  1. DIT ;-- this is where i get the discharge iens
  1.  W !,"I am getting the new discharge type pointers..."
  1.  S FMNM=0 F  S FMNM=$O(^DIC(42.2,"B",FMNM)) Q:FMNM=""  D
  1.  . S FMIEN=0 F  S FMIEN=$O(^DIC(42.2,"B",FMNM,FMIEN)) Q:FMIEN=""  D
  1.  .. Q:'$D(^DG(405.1,"B",FMNM))
  1.  .. S DIT(FMIEN)=$O(^DG(405.1,"B",FMNM,0))
  1.  .. W "."
  1.  Q
  1.  ;
  1. GET ;-- go through the hospital location file and grab bad data nodes
  1.  W !,"I will now search for entries in the V Hospitalization file "
  1.  W "that are incomplete."
  1.  W !,"At the end of this search, I will print a list of incomplete "
  1.  W "data nodes."
  1.  H 2
  1.  ;IHS/DSD/ENM 01/26/99 NEXT LINE COPIED/MODIFIED
  1.  ;S (ENT,HLF)=0 F  S HLF=$O(^AUPNVINP(HLF)) Q:HLF'?.N  D
  1.  S (ENT,HLF)=0 F  S HLF=$O(^AUPNVINP(HLF)) Q:'HLF!(HLF'?.N)  D
  1.  . S ENT=ENT+1
  1.  . I ENT=25 W "." S ENT=0
  1.  . I '$D(^AUPNVINP(HLF)) S ^TMP($J,HLF)="NO DATA IN NODE"
  1.  . I $P(^AUPNVINP(HLF,0),U,7)="" S ^TMP($J,HLF)="NO ADMISSION TYPE"
  1.  . I $P(^AUPNVINP(HLF,0),U,6)="" S ^TMP($J,HLF)="NO DISCHARGE TYPE"
  1.  ;IHS/ASDST/ENM 12/29/98 ABOVE TWO LINES MODIFIED 6 AND 7 REV
  1.  W @IOF
  1.  D ^%ZIS
  1.  I POP W !,"You must rerun this conversion before continuing, D ^ADGGFL when ready" Q
  1.  W !,"The following data nodes have incomplete data:"
  1.  S (CNT,TMPA)=0 F  S TMPA=$O(^TMP($J,TMPA)) Q:TMPA=""  D
  1.  . Q:'$D(^TMP($J,TMPA))
  1.  . W !,"^AUPNVINP("_TMPA_",0) has "_$G(^TMP($J,TMPA))
  1.  . S CNT=CNT+1
  1.  I CNT=0 W !!,"All data in ^AUPNVINP is acceptable for conversion",!
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. SET ;-- this is where i set the nodes with the new pointers
  1.  ;-- i don't set any nodes that are incomplete
  1.  S DIR(0)="Y",DIR("A")="I will update the V HOSP pointers, continue: "
  1.  D ^DIR
  1.  G SET:$D(DIRUT)
  1.  I Y<1 W !,"You must update V HOSP pointers, D SET^ADGGFL when ready" Q
  1.  W !,"I am now repointing the V Hospitalization file "
  1.  S REC=0
  1.  I $D(^TMP("VHOSP")) S (REC,AIEN)=$G(^TMP("VHOSP"))+1
  1.  ;IHS/DSD/ENM 05/04/99 NEXT LINE COPIED/MODIFIED
  1.  ;S (ACNT,AIEN)=0 F  S AIEN=$O(^AUPNVINP(AIEN)) Q:AIEN'?.N  D
  1.  S (ACNT,AIEN)=0 F  S AIEN=$O(^AUPNVINP(AIEN)) Q:AIEN'=+AIEN  D
  1.  . Q:'$D(^AUPNVINP(AIEN))
  1.  . Q:$D(^TMP($J,AIEN))
  1.  . S ADT=$P(^AUPNVINP(AIEN,0),U,7)
  1.  . S DIT=$P(^AUPNVINP(AIEN,0),U,6)
  1.  . S NAT=$G(ADT(ADT))
  1.  . S NDT=$G(DIT(DIT))
  1.  . S $P(^AUPNVINP(AIEN,0),U,7)=NAT
  1.  . S $P(^AUPNVINP(AIEN,0),U,6)=NDT
  1.  . S ACNT=ACNT+1
  1.  . S REC=REC+1
  1.  . S ^TMP("VHOSP")=REC
  1.  . I ACNT=50 W "." S ACNT=0
  1.  W !,"Conversion completed succsessfully, "_REC_" entries updated"
  1.  Q
  1.  ;
  1. END ;-- kill the variables and quit
  1.  K FMNM,FMIEN,AIEN,ADT,DIT,NAT,NDT,DIE,DR,DA,ACNT,ENT,TMPA
  1.  K ^TMP($J),^TMP("VHOSP")
  1.  Q
  1.  ;