AZXARDLT.m

AZXARDLT ; IHS/PHXAO/TMJ - REFERRAL DELETE ;

 ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002

 ;

 S U="^"

 Q:'$D(AZXARDLT)

 Q:'AZXARDLT

 Q:'$D(^AZXAREC(AZXARDLT,0))

 ;

 ;Quit Deletion -reason to quit, ie CHS, ETC.

 ;Q:$D(^AZXAREC(AZXARDSP,41,0))  ;  Quit if CHS Authorization Multiple

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,12)]""  ; Quit if CHS Flds 1112 TO 1122

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,13)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,14)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,15)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,16)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,17)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,18)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,19)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,20)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,21)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,22)]""

 ;Q:$P($G(^AZXAREC(AZXARDSP,0)),U,29)]""  ; Quit if PCC Visit Entry

 D DELETE

 D EOJ

 Q

 ;

DELETE ;

 ;S AZXAVFLE=90001 F AZXAVL=0:0 S AZXAVFLE=$O(^DIC(AZXAVFLE)) Q:AZXAVFLE>1991075!(AZXAVFLE'=+AZXAVFLE)  D DELETE2

 ;S AZXAREF=AZXARDLT D DEL^AZXAREF K AZXAREF

 ;Do not need above line to set Delete Flag but do need to Delete Referral

 ;

 S DA=AZXARDSP,DIK="^AZXAREC(" D ^DIK K DIK

 S AZXANUM=$P($G(^AZXAREC(AZXARDSP,0)),U,2)

 Q:'$D(AZXANUM)

 W !!,"Disclosure Record Deleted - "_AZXANUM

 Q

 ;

DELETE2 ;

 Q

 S AZXAVNM=$P(^DIC(AZXAVFLE,0),U)

 S AZXAVDG=^DIC(AZXAVFLE,0,"GL"),AZXAVIGR=AZXAVDG_"""AD"",AZXARDLT,AZXAVDFN)"

 S AZXAVDFN="" F AZXAVI=1:1 S AZXAVDFN=$O(@AZXAVIGR) Q:AZXAVDFN=""  W:'$D(ZTQUEUED) "." S DIK=AZXAVDG,DA=AZXAVDFN D ^DIK

 Q

 ;

EOJ ; EOJ CLEANUP

 K AZXAVDFN,AZXAVDG,AZXARDLT,AZXAVFLE,AZXAVI,AZXAVIGR,AZXAVL,AZXAVNM,AZXACTR,AZXAH,AZXARIO,AZXARREC,AZXARSTAT,AZXASTR

 K %,X

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

 Q

AZXARDLT  ; IHS/PHXAO/TMJ - REFERRAL DELETE ;

 +1       ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002

 +2       ;

 +3        SET U="^"

 +4        IF '$DATA(AZXARDLT)

               QUIT 

 +5        IF 'AZXARDLT

               QUIT 

 +6        IF '$DATA(^AZXAREC(AZXARDLT,0))

               QUIT 

 +7       ;

 +8       ;Quit Deletion -reason to quit, ie CHS, ETC.

 +9       ;Q:$D(^AZXAREC(AZXARDSP,41,0))  ;  Quit if CHS Authorization Multiple

 +10      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,12)]""  ; Quit if CHS Flds 1112 TO 1122

 +11      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,13)]""

 +12      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,14)]""

 +13      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,15)]""

 +14      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,16)]""

 +15      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,17)]""

 +16      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,18)]""

 +17      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,19)]""

 +18      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,20)]""

 +19      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,21)]""

 +20      ;Q:$P($G(^AZXAREC(AZXARDSP,11)),U,22)]""

 +21      ;Q:$P($G(^AZXAREC(AZXARDSP,0)),U,29)]""  ; Quit if PCC Visit Entry

 +22       DO DELETE

 +23       DO EOJ

 +24       QUIT 

 +25      ;

DELETE    ;

 +1       ;S AZXAVFLE=90001 F AZXAVL=0:0 S AZXAVFLE=$O(^DIC(AZXAVFLE)) Q:AZXAVFLE>1991075!(AZXAVFLE'=+AZXAVFLE)  D DELETE2

 +2       ;S AZXAREF=AZXARDLT D DEL^AZXAREF K AZXAREF

 +3       ;Do not need above line to set Delete Flag but do need to Delete Referral

 +4       ;

 +5        SET DA=AZXARDSP

           SET DIK="^AZXAREC("

           DO ^DIK

           KILL DIK

 +6        SET AZXANUM=$PIECE($GET(^AZXAREC(AZXARDSP,0)),U,2)

 +7        IF '$DATA(AZXANUM)

               QUIT 

 +8        WRITE !!,"Disclosure Record Deleted - "_AZXANUM

 +9        QUIT 

 +10      ;

DELETE2   ;

 +1        QUIT 

 +2        SET AZXAVNM=$PIECE(^DIC(AZXAVFLE,0),U)

 +3        SET AZXAVDG=^DIC(AZXAVFLE,0,"GL")

           SET AZXAVIGR=AZXAVDG_"""AD"",AZXARDLT,AZXAVDFN)"

 +4        SET AZXAVDFN=""

           FOR AZXAVI=1:1

               SET AZXAVDFN=$ORDER(@AZXAVIGR)

               IF AZXAVDFN=""

                   QUIT 

               IF '$DATA(ZTQUEUED)

                   WRITE "."

               SET DIK=AZXAVDG

               SET DA=AZXAVDFN

               DO ^DIK

 +5        QUIT 

 +6       ;

EOJ       ; EOJ CLEANUP

 +1        KILL AZXAVDFN,AZXAVDG,AZXARDLT,AZXAVFLE,AZXAVI,AZXAVIGR,AZXAVL,AZXAVNM,AZXACTR,AZXAH,AZXARIO,AZXARREC,AZXARSTAT,AZXASTR

 +2        KILL %,X

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

 +4        QUIT