APCDVDLT.m

APCDVDLT ; IHS/CMI/LAB - VISIT DELETE ;

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

 ;

 ;

EN ;PEP - can be called with APCDVDLT set to visit to delete

 S U="^"

 Q:'$D(APCDVDLT)

 Q:'APCDVDLT

 Q:'$D(^AUPNVSIT(APCDVDLT,0))

 D DELETE

 D EOJ

 Q

 ;

DELETE ;

 S APCDVFLE=9000010 F APCDVL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D DELETE2

 S AUPNVSIT=APCDVDLT D DEL^AUPNVSIT K AUPNVSIT

 ;

 ;call module pcc control

 ;     APCDVDLT= Deleted visit ien

 ;

 F APCDVM=0:0 S APCDVM=$O(^APCDLINK(APCDVM)) Q:APCDVM'=+APCDVM  X:$D(^(APCDVM,3)) ^(3)

 K APCDVM

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

DELETE2 ;

 S APCDVNM=$P(^DIC(APCDVFLE,0),U)

 S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDLT,APCDVDFN)"

 S APCDVDFN="" F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN=""  W:'$D(ZTQUEUED) "." S DIK=APCDVDG,DA=APCDVDFN D ^DIK

 Q

 ;

EOJ ; EOJ CLEANUP

 K APCDVDFN,APCDVDG,APCDVDLT,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM

 K %,X

 K D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR

 Q

APCDVDLT  ; IHS/CMI/LAB - VISIT DELETE ;

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

 +2       ;

 +3       ;

EN        ;PEP - can be called with APCDVDLT set to visit to delete

 +1        SET U="^"

 +2        IF '$DATA(APCDVDLT)

               QUIT 

 +3        IF 'APCDVDLT

               QUIT 

 +4        IF '$DATA(^AUPNVSIT(APCDVDLT,0))

               QUIT 

 +5        DO DELETE

 +6        DO EOJ

 +7        QUIT 

 +8       ;

DELETE    ;

 +1        SET APCDVFLE=9000010

           FOR APCDVL=0:0

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

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

                   QUIT 

               DO DELETE2

 +2        SET AUPNVSIT=APCDVDLT

           DO DEL^AUPNVSIT

           KILL AUPNVSIT

 +3       ;

 +4       ;call module pcc control

 +5       ;     APCDVDLT= Deleted visit ien

 +6       ;

 +7        FOR APCDVM=0:0

               SET APCDVM=$ORDER(^APCDLINK(APCDVM))

               IF APCDVM'=+APCDVM

                   QUIT 

               IF $DATA(^(APCDVM,3))

                   XECUTE ^(3)

 +8        KILL APCDVM

 +9        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +10       QUIT 

 +11      ;

DELETE2   ;

 +1        SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)

 +2        SET APCDVDG=^DIC(APCDVFLE,0,"GL")

           SET APCDVIGR=APCDVDG_"""AD"",APCDVDLT,APCDVDFN)"

 +3        SET APCDVDFN=""

           FOR APCDVI=1:1

               SET APCDVDFN=$ORDER(@APCDVIGR)

               IF APCDVDFN=""

                   QUIT 

               IF '$DATA(ZTQUEUED)

                   WRITE "."

               SET DIK=APCDVDG

               SET DA=APCDVDFN

               DO ^DIK

 +4        QUIT 

 +5       ;

EOJ       ; EOJ CLEANUP

 +1        KILL APCDVDFN,APCDVDG,APCDVDLT,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM

 +2        KILL %,X

 +3        KILL D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR

 +4        QUIT