AUPNPOST ; IHS/CMI/LAB - FIX INCOMPLETE V FILE ENTRIES CAUSED BY DICR BUG 24-MAY-1993 ;
;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999
INFORM ;
W:$D(IOF) @IOF
W !!,"This is the post init to the AUPN package. It will do the following:",!
W !,"1. Move the .07 field of V DIAGNOSTIC PROCEDURE to field 1208."
W !,"2. Move the .07 field of V Medication to 1202."
W !,"3. Move the .09 field of V Lab to 1202."
W !,"4. Reindex the AA xref on V CPT"
W !,"5. Check to see if you are running MAS 5.0"
VHOSP ;
;if running mas 5 do ^AUP1INIT
S APCD("VERSION")="",APCD("VERSION")=$O(^DIC(9.4,"C","DG",APCD("VERSION"))) I APCD("VERSION")]"" S APCD("VERSION")=^DIC(9.4,APCD("VERSION"),"VERSION")
I APCD("VERSION")>4.999 D
.W !! F L=1:1:4 W *7,"*** ATTENTION ***" H 1 W:L'=4 *13,$J("",79),*13
.W !!,$C(7),$C(7),$C(7),"YOU ARE RUNNING VERSION 5 OR GREATER OF ADT. PLEASE RUN ^AUP1INIT",!!
CONT ;
W !!,"If you are an alpha or beta site and this post-init was run successfully",!,"during a previous install, it does not have to run again. Answer YES"
W !,"to the next question.",!
S DIR(0)="Y",DIR("A")="Has this post-init been run to completion once before",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"Please answer the question!" G CONT
I Y G XIT
QUEUE ;
K ZTSK
W !! S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run in the background",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y=1 D TSKMN Q
PROCESS ;
S AUPNBT=$H
VDXP ;
W:'$D(ZTQUEUED) !,"Moving .07 of V DIAGNOSTIC PROCEDURE to 1208..."
S X=0 F S X=$O(^AUPNVDXP(X)) Q:X'=+X I $P(^AUPNVDXP(X,0),U,7)]"" S $P(^AUPNVDXP(X,12),U,8)=$P(^AUPNVDXP(X,0),U,7),$P(^AUPNVDXP(X,0),U,7)=""
W:'$D(ZTQUEUED) " Done"
VPRV ;move provider fields
I '$D(ZTQUEUED) W !,"The obsolete .07 in VLAB and the .09 in V MEDICATION are being moved to the",!,"1202 field. Please wait, a dot will print for every 5000 entries.",!,"This will take awhile."
;MOVE V MED .09 TO 1202
W:'$D(ZTQUEUED) !,"Processing V MEDICATION"
S (X,C)=0 F S X=$O(^AUPNVMED(X)) Q:X'=+X I $P($G(^AUPNVMED(X,12)),U,2)="",$P($G(^AUPNVMED(X,0)),U,9) S $P(^AUPNVMED(X,12),U,2)=$P(^AUPNVMED(X,0),U,9),$P(^AUPNVMED(X,0),U,9)="",C=C+1 I '$D(ZTQUEUED),'(C#5000) W "."
W:'$D(ZTQUEUED) " Done"
W:'$D(ZTQUEUED) !,"Processing V LAB"
S (X,C)=0 F S X=$O(^AUPNVLAB(X)) Q:X'=+X I $P($G(^AUPNVLAB(X,12)),U,2)="",$P($G(^AUPNVLAB(X,0)),U,7) S $P(^AUPNVLAB(X,12),U,2)=$P(^AUPNVLAB(X,0),U,7),$P(^AUPNVLAB(X,0),U,7)="",C=C+1 I '$D(ZTQUEUED),'(C#5000) W "."
CPT ;reindex AA on V CPT
W:'$D(ZTQUEUED) !!,"Reindexing AA on V CPT",!
K ^AUPNVCPT("AA")
S DIK="^AUPNVCPT(",DIK(1)=".03^AA" D ENALL^DIK
MSG ;send mail message when done
W:'$D(ZTQUEUED) !!,"ALL DONE!!!"
S AUPNET=$H D DONE
;SEND MESSAGE
S XMDUZ=.5
S AUPNPOST(1,0)="The AUPN package post init successfully completed on "_$$HTE^XLFDT($H,2),XMTEXT="AUPNPOST("
S XMSUB="AUPN POST INIT COMPLETION"
S X=DUZ,XMY(X)=""
D ^XMD K XMY,XMTEXT
D XIT
Q
TSKMN ;
S ZTIO="",ZTRTN="PROCESS^AUPNPOST",ZTDTH="",ZTDESC="AUPN PACKAGE POST-INIT" D ^%ZTLOAD D XIT K ZTSK Q
XIT ;
K X,Y,DIE,DIU,DIV,DR,DA,XMTEXT,AUPNPOST,AUPNBT,AUPNET,DIC,C,DIK,XMDUZ,XMZ,AUPN
Q
DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
I $D(AUPNET) S AUPNTS=(86400*($P(AUPNET,",")-$P(AUPNBT,",")))+($P(AUPNET,",",2)-$P(AUPNBT,",",2)),AUPNH=$P(AUPNTS/3600,".") S:AUPNH="" AUPNH=0 D
.S AUPNTS=AUPNTS-(AUPNH*3600),AUPNM=$P(AUPNTS/60,".") S:AUPNM="" AUPNM=0 S AUPNTS=AUPNTS-(AUPNM*60),AUPNS=AUPNTS S AUPNPOST(2,0)="",AUPNPOST(3,0)="RUN TIME (H.M.S): "_AUPNH_"."_AUPNM_"."_AUPNS
K AUPNTS,AUPNS,AUPNH,AUPNM,AUPNET
Q
AUPNPOST ; IHS/CMI/LAB - FIX INCOMPLETE V FILE ENTRIES CAUSED BY DICR BUG 24-MAY-1993 ;
+1 ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"This is the post init to the AUPN package. It will do the following:",!
+3 WRITE !,"1. Move the .07 field of V DIAGNOSTIC PROCEDURE to field 1208."
+4 WRITE !,"2. Move the .07 field of V Medication to 1202."
+5 WRITE !,"3. Move the .09 field of V Lab to 1202."
+6 WRITE !,"4. Reindex the AA xref on V CPT"
+7 WRITE !,"5. Check to see if you are running MAS 5.0"
VHOSP ;
+1 ;if running mas 5 do ^AUP1INIT
+2 SET APCD("VERSION")=""
SET APCD("VERSION")=$ORDER(^DIC(9.4,"C","DG",APCD("VERSION")))
IF APCD("VERSION")]""
SET APCD("VERSION")=^DIC(9.4,APCD("VERSION"),"VERSION")
+3 IF APCD("VERSION")>4.999
Begin DoDot:1
+4 WRITE !!
FOR L=1:1:4
WRITE *7,"*** ATTENTION ***"
HANG 1
IF L'=4
WRITE *13,$JUSTIFY("",79),*13
+5 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),"YOU ARE RUNNING VERSION 5 OR GREATER OF ADT. PLEASE RUN ^AUP1INIT",!!
End DoDot:1
CONT ;
+1 WRITE !!,"If you are an alpha or beta site and this post-init was run successfully",!,"during a previous install, it does not have to run again. Answer YES"
+2 WRITE !,"to the next question.",!
+3 SET DIR(0)="Y"
SET DIR("A")="Has this post-init been run to completion once before"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !!,"Please answer the question!"
GOTO CONT
+5 IF Y
GOTO XIT
QUEUE ;
+1 KILL ZTSK
+2 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to QUEUE this to run in the background"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=1
DO TSKMN
QUIT
PROCESS ;
+1 SET AUPNBT=$HOROLOG
VDXP ;
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Moving .07 of V DIAGNOSTIC PROCEDURE to 1208..."
+2 SET X=0
FOR
SET X=$ORDER(^AUPNVDXP(X))
IF X'=+X
QUIT
IF $PIECE(^AUPNVDXP(X,0),U,7)]""
SET $PIECE(^AUPNVDXP(X,12),U,8)=$PIECE(^AUPNVDXP(X,0),U,7)
SET $PIECE(^AUPNVDXP(X,0),U,7)=""
+3 IF '$DATA(ZTQUEUED)
WRITE " Done"
VPRV ;move provider fields
+1 IF '$DATA(ZTQUEUED)
WRITE !,"The obsolete .07 in VLAB and the .09 in V MEDICATION are being moved to the",!,"1202 field. Please wait, a dot will print for every 5000 entries.",!,"This will take awhile."
+2 ;MOVE V MED .09 TO 1202
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Processing V MEDICATION"
+4 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVMED(X))
IF X'=+X
QUIT
IF $PIECE($GET(^AUPNVMED(X,12)),U,2)=""
IF $PIECE($GET(^AUPNVMED(X,0)),U,9)
SET $PIECE(^AUPNVMED(X,12),U,2)=$PIECE(^AUPNVMED(X,0),U,9)
SET $PIECE(^AUPNVMED(X,0),U,9)=""
SET C=C+1
IF '$DATA(ZTQUEUED)
IF '(C#5000)
WRITE "."
+5 IF '$DATA(ZTQUEUED)
WRITE " Done"
+6 IF '$DATA(ZTQUEUED)
WRITE !,"Processing V LAB"
+7 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVLAB(X))
IF X'=+X
QUIT
IF $PIECE($GET(^AUPNVLAB(X,12)),U,2)=""
IF $PIECE($GET(^AUPNVLAB(X,0)),U,7)
SET $PIECE(^AUPNVLAB(X,12),U,2)=$PIECE(^AUPNVLAB(X,0),U,7)
SET $PIECE(^AUPNVLAB(X,0),U,7)=""
SET C=C+1
IF '$DATA(ZTQUEUED)
IF '(C#5000)
WRITE "."
CPT ;reindex AA on V CPT
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Reindexing AA on V CPT",!
+2 KILL ^AUPNVCPT("AA")
+3 SET DIK="^AUPNVCPT("
SET DIK(1)=".03^AA"
DO ENALL^DIK
MSG ;send mail message when done
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"ALL DONE!!!"
+2 SET AUPNET=$HOROLOG
DO DONE
+3 ;SEND MESSAGE
+4 SET XMDUZ=.5
+5 SET AUPNPOST(1,0)="The AUPN package post init successfully completed on "_$$HTE^XLFDT($HOROLOG,2)
SET XMTEXT="AUPNPOST("
+6 SET XMSUB="AUPN POST INIT COMPLETION"
+7 SET X=DUZ
SET XMY(X)=""
+8 DO ^XMD
KILL XMY,XMTEXT
+9 DO XIT
+10 QUIT
TSKMN ;
+1 SET ZTIO=""
SET ZTRTN="PROCESS^AUPNPOST"
SET ZTDTH=""
SET ZTDESC="AUPN PACKAGE POST-INIT"
DO ^%ZTLOAD
DO XIT
KILL ZTSK
QUIT
XIT ;
+1 KILL X,Y,DIE,DIU,DIV,DR,DA,XMTEXT,AUPNPOST,AUPNBT,AUPNET,DIC,C,DIK,XMDUZ,XMZ,AUPN
+2 QUIT
DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
+1 IF $DATA(AUPNET)
SET AUPNTS=(86400*($PIECE(AUPNET,",")-$PIECE(AUPNBT,",")))+($PIECE(AUPNET,",",2)-$PIECE(AUPNBT,",",2))
SET AUPNH=$PIECE(AUPNTS/3600,".")
IF AUPNH=""
SET AUPNH=0
Begin DoDot:1
+2 SET AUPNTS=AUPNTS-(AUPNH*3600)
SET AUPNM=$PIECE(AUPNTS/60,".")
IF AUPNM=""
SET AUPNM=0
SET AUPNTS=AUPNTS-(AUPNM*60)
SET AUPNS=AUPNTS
SET AUPNPOST(2,0)=""
SET AUPNPOST(3,0)="RUN TIME (H.M.S): "_AUPNH_"."_AUPNM_"."_AUPNS
End DoDot:1
+3 KILL AUPNTS,AUPNS,AUPNH,AUPNM,AUPNET
+4 QUIT
