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