BRNRDLT.m

BRNRDLT ; IHS/PHXAO/TMJ - REFERRAL DELETE ;  

 ;;2.0;RELEASE OF INFO SYSTEM;;APR 10, 2003

 ;

 S U="^"

 Q:'$D(BRNRDLT)

 Q:'BRNRDLT

 Q:'$D(^BRNREC(BRNRDLT,0))

 ;

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

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

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

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,13)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,14)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,15)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,16)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,17)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,18)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,19)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,20)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,21)]""

 ;Q:$P($G(^BRNREC(BRNRDSP,11)),U,22)]""

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

 D DELETE

 D EOJ

 Q

 ;

DELETE ;

 ;S BRNVFLE=90001 F BRNVL=0:0 S BRNVFLE=$O(^DIC(BRNVFLE)) Q:BRNVFLE>90264!(BRNVFLE'=+BRNVFLE)  D DELETE2

 ;S BRNREF=BRNRDLT D DEL^BRNREF K BRNREF

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

 ;

 S DA=BRNRDSP,DIK="^BRNREC(" D ^DIK K DIK

 S BRNNUM=$P($G(^BRNREC(BRNRDSP,0)),U,2)

 Q:'$D(BRNNUM)

 W !!,"Disclosure Record Deleted - "_BRNNUM

 Q

 ;

DELETE2 ;

 Q

 S BRNVNM=$P(^DIC(BRNVFLE,0),U)

 S BRNVDG=^DIC(BRNVFLE,0,"GL"),BRNVIGR=BRNVDG_"""AD"",BRNRDLT,BRNVDFN)"

 S BRNVDFN="" F BRNVI=1:1 S BRNVDFN=$O(@BRNVIGR) Q:BRNVDFN=""  W:'$D(ZTQUEUED) "." S DIK=BRNVDG,DA=BRNVDFN D ^DIK

 Q

 ;

EOJ ; EOJ CLEANUP

 K BRNVDFN,BRNVDG,BRNRDLT,BRNVFLE,BRNVI,BRNVIGR,BRNVL,BRNVNM,BRNCTR,BRNH,BRNRIO,BRNRREC,BRNRSTAT,BRNSTR

 K %,X

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

 Q

BRNRDLT   ; IHS/PHXAO/TMJ - REFERRAL DELETE ;  

 +1       ;;2.0;RELEASE OF INFO SYSTEM;;APR 10, 2003

 +2       ;

 +3        SET U="^"

 +4        IF '$DATA(BRNRDLT)

               QUIT 

 +5        IF 'BRNRDLT

               QUIT 

 +6        IF '$DATA(^BRNREC(BRNRDLT,0))

               QUIT 

 +7       ;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 +22       DO DELETE

 +23       DO EOJ

 +24       QUIT 

 +25      ;

DELETE    ;

 +1       ;S BRNVFLE=90001 F BRNVL=0:0 S BRNVFLE=$O(^DIC(BRNVFLE)) Q:BRNVFLE>90264!(BRNVFLE'=+BRNVFLE)  D DELETE2

 +2       ;S BRNREF=BRNRDLT D DEL^BRNREF K BRNREF

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

 +4       ;

 +5        SET DA=BRNRDSP

           SET DIK="^BRNREC("

           DO ^DIK

           KILL DIK

 +6        SET BRNNUM=$PIECE($GET(^BRNREC(BRNRDSP,0)),U,2)

 +7        IF '$DATA(BRNNUM)

               QUIT 

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

 +9        QUIT 

 +10      ;

DELETE2   ;

 +1        QUIT 

 +2        SET BRNVNM=$PIECE(^DIC(BRNVFLE,0),U)

 +3        SET BRNVDG=^DIC(BRNVFLE,0,"GL")

           SET BRNVIGR=BRNVDG_"""AD"",BRNRDLT,BRNVDFN)"

 +4        SET BRNVDFN=""

           FOR BRNVI=1:1

               SET BRNVDFN=$ORDER(@BRNVIGR)

               IF BRNVDFN=""

                   QUIT 

               IF '$DATA(ZTQUEUED)

                   WRITE "."

               SET DIK=BRNVDG

               SET DA=BRNVDFN

               DO ^DIK

 +5        QUIT 

 +6       ;

EOJ       ; EOJ CLEANUP

 +1        KILL BRNVDFN,BRNVDG,BRNRDLT,BRNVFLE,BRNVI,BRNVIGR,BRNVL,BRNVNM,BRNCTR,BRNH,BRNRIO,BRNRREC,BRNRSTAT,BRNSTR

 +2        KILL %,X

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

 +4        QUIT