TMGNDF4B ;TMG/kst/FDA Import: Activation of POI's ;03/25/06
         ;;1.0;TMG-LIB;**1**;11/21/06
 
 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
 ;"      Activation of records in PHARMACY ORDERABLE ITEM file
 ;"Kevin Toppenberg MD
 ;"GNU General Public License (GPL) applies
 ;"11-21-2006
 
 ;"=======================================================================
 ;" API -- Public Functions.
 ;"=======================================================================
 ;"Menu
 
 ;"ActivAll -- remove the inactive date for all records in 50.7
 ;"Activ1TMG(IEN) --  activate records linked from 22706.9 in 50.7
 ;"Activ1Rx(IEN50) -- activate records linked from 50 in 50.7
 
 ;"=======================================================================
 ;" Private Functions.
 ;"=======================================================================
 ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter
 ;"XFormOff  -- remove restrinction in input transform that prevents deletion.
 ;"XFormOn -- restore the input transform to field .04 in file 50.7
 ;"SetXForm(code) -- remove the old input transform, and replace with code
 
 
 ;"=======================================================================
 
Menu
 
        new Menu,UsrSlct
        set Menu(0)="Pick Option to Activate PHARMACY ORDERABLE ITEMS (4B)"
        set Menu(1)="Activate import PHARMACY ORDERABLE ITEMS."_$char(9)_"ActivateImports"
        set Menu(2)="Inactivate POI's NOT from an active FDA import."_$char(9)_"InactivateNonImports"
        set Menu(3)="Check for duplicate entries in POI file"_$char(9)_"Check4Dups"
        set Menu(4)="Check for dangling entries in POI file"_$char(9)_"Check4Dangle"
        set Menu("P")="Prev Stage"_$char(9)_"Prev"
        set Menu("N")="Next Stage"_$char(9)_"Next"
 
M1      write #
        set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
 
        if UsrSlct="ActivateImports" do ActivRecs(1) goto M1
        if UsrSlct="InactivateNonImports" do InactivateNonImports("NOW") goto M1
        if UsrSlct="Check4Dups" do Check4Dups goto M1
        if UsrSlct="Check4Dangle" do Check4Dangle goto M1
        if UsrSlct="Prev" goto Menu^TMGNDF4A  ;"quit can occur from there...
        if UsrSlct="Next" goto Menu^TMGNDF4C  ;"quit can occur from there...
        if UsrSlct="^" goto MenuDone
        goto M1
 
MenuDone
        quit
 
 ;"=============================================================================
 
ActivRecs(OnlyImports)
        ;"Purpose: To activate records in 50.7 by removing the inactivation date
        ;"Input:   OnlyImports: if 1 then only records linked to a FDA import will be modified.
        ;"                      if 0 then ALL records will be modified.
        ;"Results: none
 
        new date,%T,X,Y
        set X="1/1/1960"
        do ^%DT
        if Y'>0 goto AvADone
        set date=Y
 
        do ActivateImports(date,OnlyImports)
AvADone
        quit
 
 
Activ1TMG(IEN,Option)
        ;"Purpose: To activate records linked from 22706.9 in 50.7 by removing the inactivation date
        ;"Input: IEN -- IEN in 22706.9
        ;"Get 22706.9 --> 50 --> 50.7
        ;"            --> 50 --> 50.7
        new gIEN50,tIEN50
        set tIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",1)
        set gIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",2)
        do Activ1Rx(tIEN50)
        do Activ1Rx(gIEN50)
 
        quit
 
 
Activ1Rx(IEN50)
        ;"Purpose: To activate records linked from 50 in 50.7 by removing the inactivation date
        ;"Input: IEN -- IEN in 22706.9
        ;"Result: none
 
        new date,%T,X,Y
        set X="1/1/1960"
        do ^%DT
        if Y'>0 goto AvADone
        set date=Y
 
        do XFormOff
 
        ;"Get 50 --> 50.7
        if +$get(IEN50)'>0 goto A1RxDone
        new IEN50d7
        set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1)
        if IEN50d7=0 quit
        new temp set temp=$$Active1(IEN50d7,date)
 
        do XFormOn
 
A1RxDone
        quit
 
 
ActivateImports(DateAfter,OnlyImports)
        ;"Purpose: To remove inactive date for all records in PHARMACY ORDERABLE ITEM
        ;"         having an inactive date on/after DateAfter
        ;"Input: DateAfter -- the date to compare the inactive date with.  If the
        ;"                   inactive date is on/after DateAfter, then inactive date
        ;"                   will be deleted.
        ;"                   ** Must be in Fileman Date format
        ;"       OnlyImports: if 1 then only records linked to a FDA import will be modified.
        ;"                    if 0 then ALL records will be modified.
 
        do XFormOff
 
        new Itr,IEN,Date,Y,X
        new count set count=0
        new abort set abort=0
 
        write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to activate those",!
        write "  records linked to an active (non-skipped) FDA import...",!
        set IEN=$$ItrInit^TMGITR(50.7,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN")
        if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0)
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . if (OnlyImports=1),($$IsImport^TMGNDFUT(IEN)=0) quit
        . new temp set temp=$$Active1(IEN,DateAfter)
        . if temp=2 set count=count+1
        do ProgressDone^TMGITR(.Itr)
 
        do XFormOn
        kill TMGXFORM
 
        write count," records modified.",!
        do PressToCont^TMGUSRIF
 
        quit
 
 
Active1(IEN,DateAfter)
        ;"Purpose: To remove inactive date for one records in PHARMACY ORDERABLE ITEM
        ;"         having an inactive date on/after DateAfter
        ;"Input:  IEN -- the IEN from file 50.7 to affect
        ;"        DateAfter -- the date to compare the inactive date with.  If the
        ;"                     inactive date is on/after DateAfter, then inactive date
        ;"                     will be deleted.
        ;"                     ** Must be in Fileman Date format
        ;"Results: 1=OK, 0 error occurred, 2 if modification made
        ;"NOTE: The XFormOff should be called before this is called, and XFormON called after
 
 
        new Date,Y,X
        new abort set abort=-5
        new TMGFDA,TMGMSG
        new X1,X2
        new result set result=1
 
        set X2=$piece($get(^PS(50.7,IEN,0)),"^",4)  ;"0;4 --> inactive date
        if X2="" goto A1Done
        ;"set X1=DateAfter
        ;"do ^%DTC
        set TMGFDA(50.7,IEN_",",.04)=""  ;"kill inactive date
        new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q"
        do FILE^DIE("K","TMGFDA","TMGMSG")
        new PriorErrorFound
        if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto A1Done
        set X2=$piece($get(^PS(50.7,IEN,0)),"^",4)  ;"0;4 --> inactive date
        if X2'="" do  goto A1Done
        . write "Deletion of 50.7 inactivation date (",X2,") FAILED in record: ",IEN,!
        . set result=0
 
        set result=2
A1Done
        quit result
 
 
InactivateNonImports(Date)
        ;"Purpose: To inactive records in PHARMACY ORDERABLE ITEM not linked to a FDA import
        ;"Input: DateAfter -- OPTIONAL.  Default is "NOW"
        ;"                   The date to to use for the inactivation
        ;"                   ** Must be in EXTERNAL format
        ;"Results: none
 
        do XFormOff
 
        new Itr,IEN,Date,Y,X
        set Date=$get(Date,"NOW")
        new abort set abort=0
        new count set count=0
 
        write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to inactivate those NOT",!
        write "  linked to an active (i.e. non-skipped) FDA import...",!
        set IEN=$$ItrInit^TMGITR(50.7,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN")
        if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0)
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . if $$IsImport^TMGNDFUT(IEN)=1 quit
        . new temp set temp=$$InActv1(IEN,Date)
        . if temp=2 set count=count+1
        do ProgressDone^TMGITR(.Itr)
 
        do XFormOn
        kill TMGXFORM
 
        ;"Now check that all skipped imports don't point to POI records.
        ;"And that pointers point to valid records.
        new ChangeCt set ChangeCt=0
        new Itr,IEN22706d9
        new abort set abort=0
        write !,"Checking Imports for links to bad POI records",!
        set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9")
        if IEN22706d9'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . new tIEN50d7 set tIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
        . set count=count+$$Verify1(IEN22706d9,tIEN50d7,"TRADE")
        . new gIEN50d7 set gIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
        . set count=count+$$Verify1(IEN22706d9,gIEN50d7,"GENERIC")
        do ProgressDone^TMGITR(.Itr)
 
        write count," records modified.",!
        do PressToCont^TMGUSRIF
 
        quit
 
 
Verify1(IEN22706d9,IEN50d7,mode)
        ;"To Verify one
        ;"Input: IEN22706d9
        ;"       IEN50 -- link to PHARMACY ORDERABLE ITEM file (either for Generic Drug, or Trade Drug)
        ;"       mode - "GENERIC" or "TRADE"
        ;"Result: 0 -- no change, 1= change made
 
        new result set result=0
        new field50d7 set field50d7=""
        new fieldName set fieldName=""
        new node,pce set (node,pce)=""
        if mode="GENERIC" do
        . set field50d7=5.71
        . set fieldName=.075
        . set node=7,pce=4
        else  if mode="TRADE" do
        . set field50d7=5.61
        . set fieldName=.055
        . set node=7,pce=3
        if (field50d7="") goto V1Done
        if (IEN50d7="") goto V1Done
 
        new drugName set drugName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1)
        new TMGName set TMGName=$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce)
        set TMGName=$translate(TMGName,";",":")
 
        if $data(^PS(50.7,+$get(IEN50d7)))=0 do
        . write "Bad pointer: ",IEN50d7
        . set IEN50d7=0
 
        if drugName'=TMGName do
        . write IEN22706d9," (",$extract(mode,1),"): Name mismatch: ",drugName," vs ",TMGName,!
        . if TMGName="" set IEN50d7=0
 
        if $get(IEN50d7)=0 do  goto V1Done
        . new TMGFDA,TMGMSG
        . set TMGFDA(22706.9,IEN22706d9_",",field50d7)="@"
        . do UPDATE^DIE("","TMGFDA","TMGMSG")
        . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . write "  ... fixed.",!
        . set result=1
V1Done
        quit result
 
 
InActv1(IEN,Date)
        ;"Purpose: To set inactive date for one records in PHARMACY ORDERABLE ITEM
        ;"         having no inactive date
        ;"Input:  IEN -- the IEN from file 50.7 to affect
        ;"        Date -- the date to set inactive date to.  Should be EXTERNAL FORMAT
        ;"Results: 1=OK, 0 error occurred, 2 if record modified
        ;"NOTE: The XFormOff should be called before this is called, and XFormON called after
 
        new abort set abort=-5
        new TMGFDA,TMGMSG
        new X1,X2
        new result set result=1
 
        set X2=$piece($get(^PS(50.7,IEN,0)),"^",4)  ;"0;4 --> inactive date
        if X2'="" goto IA1Done
        set TMGFDA(50.7,IEN_",",.04)=Date  ;"new inactive date
        new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q"
        do FILE^DIE("EK","TMGFDA","TMGMSG")
        new PriorErrorFound
        if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto IA1Done
        set result=2
IA1Done
        quit result
 
 
XFormOff
        ;"Purpose: to remove restrinction in input transform that prevents deletion.
 
        ;"new TMGXFORM  ;NOTE: NO new -- will be killed later
        set TMGXFORM=$piece($get(^DD(50.7,.04,0)),"^",5,99)
        merge ^TMG("TMP","XREF",50.7,.04,1)=^DD(50.7,.04,1)
        kill ^DD(50.7,.04,1)  ;"kill off the screening xref code
        do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""")
 
        quit
 
 
XFormOn
        ;"Purpose: to restore the input transform to field .04 in file 50.7
 
        set TMGXFORM=$get(TMGXFORM,"S %DT=""EX"" D ^%DT S X=Y K:Y<1 X")
        do SetXForm(TMGXFORM)
        kill ^DD(50.7,.04,1)
        merge ^DD(50.7,.04,1)=^TMG("TMP","XREF",50.7,.04,1) ;"restore screening xref code
        quit
 
 
SetXForm(code)
        ;"Purpose: to remove the old input transform, and replace with code
 
        set $piece(^DD(50.7,.04,0),"^",5,99)=""  ;"clear out old stuff
        set $piece(^DD(50.7,.04,0),"^",5)=code
        ;"zwr ^DD(50.7,.04,0)
        quit
 
 
Check4Dups
        ;"Purpose: to ensure that there are not two entries in the PHARMACY ORDERABLE ITEM
        ;"         file with the same name.
 
        new array,dupArray
 
        new Itr,IEN
        new abort set abort=0
        set IEN=$$ItrInit^TMGITR(50.7,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN")
        if IEN'="" for  do  quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . new name set name=$piece($get(^PS(50.7,IEN,0)),"^",1)
        . new priorIEN set priorIEN=+$order(array(name,""))
        . if priorIEN'=0 do
        . . write !,name," previously found...",!
        . . set dupArray(name,priorIEN)=""
        . . set dupArray(name,IEN)=""
        . set array(name,IEN)=""
        do ProgressDone^TMGITR(.Itr)
 
        new count set count=0
        new fixName set fixName=""
        for  set fixName=$order(dupArray(fixName)) quit:(fixName="")  do
        . new keepIEN set keepIEN=$order(dupArray(fixName,""))
        . new IEN50d7 set IEN50d7=keepIEN
        . for  set IEN50d7=$order(dupArray(fixName,IEN50d7)) quit:(IEN50d7="")  do
        . . new IEN50Array
        . . do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array)
        . . new IEN50 set IEN50=""
        . . for  set IEN50=+$order(IEN50Array(IEN50)) quit:(IEN50=0)  do
        . . . new TMGFDA,TMGMSG
        . . . set TMGFDA(50,IEN50_",",2.1)=keepIEN  ;"redirect to ONE kept record
        . . . do FILE^DIE("S","TMGFDA","TMGMSG")
        . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . kill TMGFDA,TMGMSG
        . . set TMGFDA(50.7,IEN50d7_",",.01)="@"  ;"kill duplicate record
        . . do FILE^DIE("S","TMGFDA","TMGMSG")
        . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . set count=count+1
 
        write !,count," Modifications Made.",!
 
        do PressToCont^TMGUSRIF
        quit
 
 
Check4Dangle
        ;"Purpose: to ensure that there are no dangling entries in the PHARMACY
        ;"         ORDERABLE ITEM file
 
        new fixArray
 
        new goodCount set goodCount=0
        new badCount set badCount=0
        new count set count=0
        new Itr,IEN50d7
        new abort set abort=0
        set IEN50d7=$$ItrInit^TMGITR(50.7,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN50d7")
        if IEN50d7'="" for  do  quit:(+$$ItrNext^TMGITR(.Itr,.IEN50d7)'>0)!abort
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . new dangle set dangle=1 ;"default to dangle
        .
        . new tempC,tempA,IEN50
        . merge tempA=^PSDRUG("ASP",IEN50d7)
        . do GetpDRUGs^TMGNDFUT(IEN50d7,.tempC,1)
        .
        . set IEN50=""
        . for  set IEN50=$order(tempC(IEN50)) quit:(IEN50="")  kill tempA(IEN50)
        . set IEN50="" for  set IEN50=$order(tempA(IEN50)) quit:(IEN50="")  do
        . . if $piece($get(^PSDRUG(IEN50,"I")),"^",1)'="" kill tempA(IEN50)
        .
        . set IEN50=""
        . for  set IEN50=$order(tempA(IEN50)) quit:(IEN50="")  do
        . . write "50 #",IEN50," (",$$GET1^DIQ(50,IEN50_",",.01),") found that",!
        . . write "  --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
        . . new IEN22706d9
        . . set IEN22706d9=$order(^TMG(22706.9,"DRUGT",IEN50,""))
        . . if IEN22706d9="" do
        . . . write "But there is no entry in 22706.9 pointing to this #50 record.",!
        . . . write " ... deleting.",!
        . . . do KillPOI^TMGNDFUT(IEN50d7)
        . . else  do
        . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do  quit; 1= SKIP
        . . . . write "But the 22706.9 entry pointing to this is SKIPPED",!
        . . . else  do
        . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
        . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
        . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",!
        . . set IEN22706d9=$order(^TMG(22706.9,"DRUGG",IEN50,""))
        . . if IEN22706d9="" do
        . . . write "But there is no entry in 22706.9 pointing to this #50 record.",!
        . . else  do
        . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do  quit; 1= SKIP
        . . . . write "But the 22706.9 entry pointing to this is SKIPPED",!
        . . . else  do
        . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
        . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
        . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",!
        .
        .
        . ;"--------Check trade drug links------------
        . new tempA
        . merge tempA=^TMG(22706.9,"POIT",IEN50d7)
        . new IEN22706d9 set IEN22706d9=""
        . for  set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="")  do
        . . set dangle=0 ;"at least one link was found, so not dangling.
        . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do  quit; 1= SKIP
        . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",!
        . . . set fixArray(IEN50d7)=""
        . . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
        . . if tIEN50=0 write "??!!??",! quit
        . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(tIEN50,2)),"^",1)
        . . if tempIEN=IEN50d7 quit
        . . write !,"22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
        . . write "   --> POI #",IEN50d7," (",$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
        . . write "   --> 50 #",tIEN50," (",$$GET1^DIQ(50,tIEN50_",",.01),")",!
        . . write "       ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",!
        . . write "            Fixing this...",!
        . . new TMGFDA,TMGMSG
        . . set TMGFDA(50,tIEN50_",",2.1)=IEN50d7
        . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . set count=count+1
        . ;"--------Now check generic drug links------------
        . kill tempA
        . merge tempA=^TMG(22706.9,"POIG",IEN50d7)
        . new IEN22706d9 set IEN22706d9=""
        . for  set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="")  do
        . . set dangle=0 ;"at least one link was found, so not dangling.
        . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do  quit; 1= SKIP
        . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped 22706.9 record!",!
        . . . set fixArray(IEN50d7)=""
        . . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
        . . if gIEN50=0 write "??!!??",! quit
        . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(gIEN50,2)),"^",1)
        . . if tempIEN=IEN50d7 quit
        . . write "22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
        . . write "   --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
        . . write "   --> 50 #",gIEN50," (",$$GET1^DIQ(50,gIEN50_",",.01),")",!
        . . write "       ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",!
        . . write "            Fixing this...",!
        . . new TMGFDA,TMGMSG
        . . set TMGFDA(50,gIEN50_",",2.1)=IEN50d7
        . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . set count=count+1
        . if dangle=1 set badCount=badCount+1
 
        do ProgressDone^TMGITR(.Itr)
 
        ;"remove this line later
        set abort=0
 
        write "Scanning 22706.9 for pointers to non-existant generic POI records",!
        new IEN50d7 set IEN50d7=""
        set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
        if IEN50d7'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
        . new Itr2
        . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG",IEN50d7)),.Itr2)
        . if IEN22706d9'="" for  do  quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
        . . if $$UserAborted^TMGUSRIF set abort=1 quit
        . . if $data(^PS(50.7,IEN50d7))=0 do
        . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
        . . . write "  .. Deleting",!
        . . . do KillPOI^TMGNDFUT(IEN50d7)
        . . . set count=count+1
 
        write "Scanning 22706.9 for pointers to non-existant trade POI records",!
        kill Itr
        new IEN50d7 set IEN50d7=""
        set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
        if IEN50d7'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
        . new Itr2
        . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT",IEN50d7)),.Itr2)
        . if IEN22706d9'="" for  do  quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
        . . if $$UserAborted^TMGUSRIF set abort=1 quit
        . . if $data(^PS(50.7,IEN50d7))=0 do
        . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
        . . . write "  .. Deleting",!
        . . . do KillPOI^TMGNDFUT(IEN50d7)
        . . . set count=count+1
 
        goto C4D2 ;"xref not missing it after all.  This step not needed
        ;"For some reason xref is missing a record, so will do brute force search
        write "Brute force scan of 22706.9...",!
        kill Itr
        set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr)
        do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9")
        if IEN22706d9'="" for  do  quit:(+$$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . new tIEN50d7,gIEN50d7
        . set tIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
        . set gIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
        . if (tIEN50d7>0),$data(^PS(50.7,tIEN50d7))=0 do
        . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
        . . write "  .. Deleting",!
        . . do KillPOI^TMGNDFUT(tIEN50d7)
        . . set count=count+1
        . . set tIEN50d7=0
        . if (gIEN50d7>0),$data(^PS(50.7,gIEN50d7))=0 do
        . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
        . . write "  .. Deleting",!
        . . do KillPOI^TMGNDFUT(gIEN50d7)
        . . set count=count+1
        . . set gIEN50d7=0
        . new TMGFDA,TMGMSG
        . if tIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.61)="@"
        . if gIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.71)="@"
        . if $data(TMGFDA) do
        . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . set count=count+1
        do ProgressDone^TMGITR(.Itr)
C4D2
        write "Scanning 22706.9 for pointers to non-existant generic OI records",!
        new IEN101d43 set IEN101d43=""
        set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43")
        if IEN101d43'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort
        . new Itr2
        . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG",IEN101d43)),.Itr2)
        . if IEN22706d9'="" for  do  quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
        . . if $$UserAborted^TMGUSRIF set abort=1 quit
        . . if $data(^ORD(101.43,IEN101d43))=0 do
        . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
        . . . write "  ... Deleting",!
        . . . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@"
        . . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . . set count=count+1
 
        write "Scanning 22706.9 for pointers to non-existant trade OI records",!
        new IEN101d43 set IEN101d43=""
        set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43")
        if IEN101d43'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort
        . new Itr2
        . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT",IEN101d43)),.Itr2)
        . if IEN22706d9'="" for  do  quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
        . . if $$UserAborted^TMGUSRIF set abort=1 quit
        . . if $data(^ORD(101.43,IEN101d43))=0 do
        . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
        . . . write "  .. Deleting",!
        . . . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@"
        . . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . . set count=count+1
 
        write "Scanning 50 for pointers to non-existant POI records",!
        new IEN50d7 set IEN50d7=""
        set IEN50d7=$$ItrAInit^TMGITR($name(^PSDRUG("ASP")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
        if IEN50d7'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
        . new Itr2
        . set IEN50=$$ItrAInit^TMGITR($name(^PSDRUG("ASP",IEN50d7)),.Itr2)
        . if IEN50'="" for  do  quit:($$ItrANext^TMGITR(.Itr2,.IEN50)="")!abort
        . . if $$UserAborted^TMGUSRIF set abort=1 quit
        . . if $data(^PS(50.7,IEN50d7))=0 do
        . . . write !,"Dangling pointer in 50 #",IEN50,!
        . . . write "  .. Deleting",!
        . . . do KillPOI^TMGNDFUT(IEN50d7)
        . . . set count=count+1
 
        write "Scanning 101.43 for pointers to non-existant POI records",!
        new ID set ID=""
        set ID=$$ItrAInit^TMGITR($name(^ORD(101.43,"ID")),.Itr)
        do PrepProgress^TMGITR(.Itr,20,1,"ID")
        if ID'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.ID)="")!abort
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . set IEN50d7=$piece(ID,";",1)
        . if $data(^PS(50.7,IEN50d7))=0 do
        . . write !,"Dangling pointer in 101.43 #",IEN50,!
        . . write "  .. Deleting",!
        . . do KillPOI^TMGNDFUT(IEN50d7)
        . . set count=count+1
 
        do ProgressDone^TMGITR(.Itr)
 
        ;"write goodCount," entries are not dangling.",!
        write badCount," entries are dangling",!
 
        set IEN50d7=""
        for  set IEN50d7=$order(fixArray(IEN50d7)) quit:(IEN50d7="")!abort  do
        . if $$UserAborted^TMGUSRIF set abort=1 quit
        . write "Checking POI# ",IEN50d7,!
        . new temp merge temp=^PSDRUG("ASP",IEN50d7)
        . new IEN50 set IEN50=""
        . for  set IEN50=$order(temp(IEN50)) quit:(IEN50="")  do
        . . new name set name=$$GET1^DIQ(50,IEN50_",",.01) quit:(name="")
        . . write "   POI #",IEN50d7," IS pointed to from DRUG file, record #",IEN50," ",name,!
        . . if $$IsImport^TMGNDFUT(IEN50d7) do  quit
        . . . write "  (This record IS an active import)",!
        . . . new tempA
        . . . merge tempA=^TMG(22706.9,"POIG",IEN50d7)
        . . . merge tempA=^TMG(22706.9,"POIT",IEN50d7)
        . . . new IEN22706d9 set IEN22706d9=""
        . . . for  set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="")  do
        . . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do  quit; 1= SKIP
        . . . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",!
        . . . . new tIEN50,gIEN50
        . . . . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
        . . . . if tIEN50>0 do
        . . . . . write "22706.9 #",IEN22706d9," points to this from trade link",!
        . . . . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
        . . . . if gIEN50>0 do
        . . . . . write "22706.9 #",IEN22706d9," points to this from generic link",!
        . . else  do
        . . . write "     (This record is NOT an active import)",!
        . . . new TMGFDA,TMGMSG
        . . . set TMGFDA(50,IEN50_",",.01)="@"
        . . . do Unlock50^TMGNDFUT
        . . . do FILE^DIE("","TMGFDA","TMGMSG")
        . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . . . do Lock50^TMGNDFUT
        . . . write "Dangling entry in file 50 REMOVED.",!
        . . . set count=count+1
        . new TMGFDA,TMGMSG
        . set TMGFDA(50.7,IEN50d7_",",.01)="@"
        . do FILE^DIE("","TMGFDA","TMGMSG")
        . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . write "Dangling entries in file 50.7 REMOVED.",!
        . set count=count+1
 
 
        write !,count," Modifications Made.",!
        if count>0 write "Please run this process AGAIN.",!
 
        do PressToCont^TMGUSRIF
        quit
