APCP20P3.m

APCP20P3 ; IHS/TUCSON/LAB - post init patch 3 ; [ 08/18/2003   7:44 AM ]

 ;;2.0;IHS PCC DATA EXTRACTION;**3**;APR 03, 1998

 ;

 ;

 W !,"Re-setting .14 of visit... Hold on, this will take a little while.."

 S APCPLOG=0 NEW X S X=$O(^APCPLOG("B",2980801))

 I X S APCPLOG=$O(^APCPLOG("B",X,0))

 I 'APCPLOG S APCPLOG=$P(^APCPLOG(0),U,4)-4 I APCPLOG<0 S APCPLOG=0

 F  S APCPLOG=$O(^APCPLOG(APCPLOG)) Q:APCPLOG'=+APCPLOG  D

 .W ":",APCPLOG

 .S APCPD=$P($P(^APCPLOG(APCPLOG,0),U,3),".")

 .S APCPV=0 F  S APCPV=$O(^APCPLOG(APCPLOG,21,APCPV)) Q:APCPV'=+APCPV  D

 ..Q:'$D(^AUPNVSIT(APCPV,0))

 ..S Y=$P(^APCPLOG(APCPLOG,21,APCPV,0),U,7)

 ..Q:'Y

 ..I $P(^AUPNVSIT(APCPV,0),U,14)="" S $P(^AUPNVSIT(APCPV,0),U,14)=APCPD

 ..S $P(^APCPLOG(APCPLOG,21,APCPV,0),U,5)=1

 .Q

 W "ALL DONE"

 NEW X

 S X=$$ADD^XPDMENU("APCPMENU","APCP RE-EXPORT MENU","REX",99)

 I 'X W "Attempt to add Re-Export Menu failed." H 3

 K APCPLOG,APCPV,Y,X

 Q

APCP20P3  ; IHS/TUCSON/LAB - post init patch 3 ; [ 08/18/2003   7:44 AM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION;**3**;APR 03, 1998

 +2       ;

 +3       ;

 +4        WRITE !,"Re-setting .14 of visit... Hold on, this will take a little while.."

 +5        SET APCPLOG=0

           NEW X

           SET X=$ORDER(^APCPLOG("B",2980801))

 +6        IF X

               SET APCPLOG=$ORDER(^APCPLOG("B",X,0))

 +7        IF 'APCPLOG

               SET APCPLOG=$PIECE(^APCPLOG(0),U,4)-4

               IF APCPLOG<0

                   SET APCPLOG=0

 +8        FOR 

               SET APCPLOG=$ORDER(^APCPLOG(APCPLOG))

               IF APCPLOG'=+APCPLOG

                   QUIT 

               Begin DoDot:1

 +9                WRITE ":",APCPLOG

 +10               SET APCPD=$PIECE($PIECE(^APCPLOG(APCPLOG,0),U,3),".")

 +11               SET APCPV=0

                   FOR 

                       SET APCPV=$ORDER(^APCPLOG(APCPLOG,21,APCPV))

                       IF APCPV'=+APCPV

                           QUIT 

                       Begin DoDot:2

 +12                       IF '$DATA(^AUPNVSIT(APCPV,0))

                               QUIT 

 +13                       SET Y=$PIECE(^APCPLOG(APCPLOG,21,APCPV,0),U,7)

 +14                       IF 'Y

                               QUIT 

 +15                       IF $PIECE(^AUPNVSIT(APCPV,0),U,14)=""

                               SET $PIECE(^AUPNVSIT(APCPV,0),U,14)=APCPD

 +16                       SET $PIECE(^APCPLOG(APCPLOG,21,APCPV,0),U,5)=1

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18       WRITE "ALL DONE"

 +19       NEW X

 +20       SET X=$$ADD^XPDMENU("APCPMENU","APCP RE-EXPORT MENU","REX",99)

 +21       IF 'X

               WRITE "Attempt to add Re-Export Menu failed."

               HANG 3

 +22       KILL APCPLOG,APCPV,Y,X

 +23       QUIT