- 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
