APCPZSET.m

APCPZSET ; IHS/TUCSON/LAB - DISPLAY PCC EXPORT LOG DATA AUGUST 14, 1992 ; [ 04/29/98  1:37 PM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

EN1 ;

 W:$D(IOF) @IOF

 W !!,"Reset Visit Pointers in 21 multiple for REDO",!

 S DIC="^APCPLOG(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G XIT

 S APCPLOG=+Y

 I $D(^APCPLOG(APCPLOG,21)) W !!,"That Log HAS NOT BEEN PURGED!!" G EN1

 S B=$P(^APCPLOG(APCPLOG,0),U,1),E=$P(^(0),U,2)

 S S=$$FMADD^XLFDT(B,-1)_.9999

 S C=0 F  S S=$O(^AUPNVSIT("B",S)) Q:$P(S,".")>E  D

 .S V=0 F  S V=$O(^AUPNVSIT("B",S,V)) Q:V'=+V  D

 ..Q:$P(^AUPNVSIT(V,0),U,11)  ;deleted visit

 ..W "." S C=C+1,^APCPLOG(APCPLOG,21,V,0)=V_"^1"

 S ^APCPLOG(APCPLOG,21,0)="^9001005.2101PA^"_C_"^"_C

 D XIT

 Q

XIT ;EP

 K APCPLOG,APCPREC

 Q

APCPZSET  ; IHS/TUCSON/LAB - DISPLAY PCC EXPORT LOG DATA AUGUST 14, 1992 ; [ 04/29/98  1:37 PM ]

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

EN1       ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"Reset Visit Pointers in 21 multiple for REDO",!

 +3        SET DIC="^APCPLOG("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y=-1

               WRITE !!,"Goodbye"

               GOTO XIT

 +4        SET APCPLOG=+Y

 +5        IF $DATA(^APCPLOG(APCPLOG,21))

               WRITE !!,"That Log HAS NOT BEEN PURGED!!"

               GOTO EN1

 +6        SET B=$PIECE(^APCPLOG(APCPLOG,0),U,1)

           SET E=$PIECE(^(0),U,2)

 +7        SET S=$$FMADD^XLFDT(B,-1)_.9999

 +8        SET C=0

           FOR 

               SET S=$ORDER(^AUPNVSIT("B",S))

               IF $PIECE(S,".")>E

                   QUIT 

               Begin DoDot:1

 +9                SET V=0

                   FOR 

                       SET V=$ORDER(^AUPNVSIT("B",S,V))

                       IF V'=+V

                           QUIT 

                       Begin DoDot:2

 +10      ;deleted visit

                           IF $PIECE(^AUPNVSIT(V,0),U,11)

                               QUIT 

 +11                       WRITE "."

                           SET C=C+1

                           SET ^APCPLOG(APCPLOG,21,V,0)=V_"^1"

                       End DoDot:2

               End DoDot:1

 +12       SET ^APCPLOG(APCPLOG,21,0)="^9001005.2101PA^"_C_"^"_C

 +13       DO XIT

 +14       QUIT 

XIT       ;EP

 +1        KILL APCPLOG,APCPREC

 +2        QUIT