APCDKFDE.m

APCDKFDE ; IHS/CMI/LAB - CHECK DEPENDENT ENTRIES AND DELETE VISIT ; 

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

EN1(V) ;EP

 ;WILL DELETE WITH DEL^AUPNVSIT ANY VISIT WITH 0 DEPENDENT ENTRIES

 ;0 returned if visit not deleted

 ;1 returned if visit deleted

 ;

 I '$G(V) Q 0

 I '$D(^AUPNVSIT(V)) Q 0

 I $P(^AUPNVSIT(V,0),U,11) Q 0  ;quit if already deleted visit

 I $P(^AUPNVSIT(V,0),U,7)="H" Q 0

 I $P($G(^AUPNVSIT(V,"VCN")),U)]"" Q 0

 ;

PROCESS ;calculate dependent entry count

 NEW N,C,E,G,R,F

 S C=$P(^AUPNVSIT(V,0),U,9) D CALDEC

 I N'=C S $P(^AUPNVSIT(V,0),U,9)=N

 I N=0 S $P(^AUPNVSIT(V,22),U)="DELETED BY VISIT RE-LINKER"

 I N=0 S AUPNVSIT=V D DEL^AUPNVSIT K AUPNVSIT Q 1

 Q 0

CALDEC ;

 S N=0

 S F=9000010 F  S F=$O(^DIC(F)) Q:F>9000010.99!(F'=+F)  D CALDEC2

 Q

CALDEC2 ;

 S G=^DIC(F,0,"GL"),R=G_"""AD"",V,E)"

 S E="" F  S E=$O(@R) Q:E'=+E  S N=N+1

 Q

APCDKFDE  ; IHS/CMI/LAB - CHECK DEPENDENT ENTRIES AND DELETE VISIT ; 

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

EN1(V)    ;EP

 +1       ;WILL DELETE WITH DEL^AUPNVSIT ANY VISIT WITH 0 DEPENDENT ENTRIES

 +2       ;0 returned if visit not deleted

 +3       ;1 returned if visit deleted

 +4       ;

 +5        IF '$GET(V)

               QUIT 0

 +6        IF '$DATA(^AUPNVSIT(V))

               QUIT 0

 +7       ;quit if already deleted visit

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

               QUIT 0

 +8        IF $PIECE(^AUPNVSIT(V,0),U,7)="H"

               QUIT 0

 +9        IF $PIECE($GET(^AUPNVSIT(V,"VCN")),U)]""

               QUIT 0

 +10      ;

PROCESS   ;calculate dependent entry count

 +1        NEW N,C,E,G,R,F

 +2        SET C=$PIECE(^AUPNVSIT(V,0),U,9)

           DO CALDEC

 +3        IF N'=C

               SET $PIECE(^AUPNVSIT(V,0),U,9)=N

 +4        IF N=0

               SET $PIECE(^AUPNVSIT(V,22),U)="DELETED BY VISIT RE-LINKER"

 +5        IF N=0

               SET AUPNVSIT=V

               DO DEL^AUPNVSIT

               KILL AUPNVSIT

               QUIT 1

 +6        QUIT 0

CALDEC    ;

 +1        SET N=0

 +2        SET F=9000010

           FOR 

               SET F=$ORDER(^DIC(F))

               IF F>9000010.99!(F'=+F)

                   QUIT 

               DO CALDEC2

 +3        QUIT 

CALDEC2   ;

 +1        SET G=^DIC(F,0,"GL")

           SET R=G_"""AD"",V,E)"

 +2        SET E=""

           FOR 

               SET E=$ORDER(@R)

               IF E'=+E

                   QUIT 

               SET N=N+1

 +3        QUIT