TMGNDFUT ;TMG/kst/FDA Import -- Fix OQV Problems;11/20/07
;;1.0;TMG-LIB;**1**;11/20/07
;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
;" Utility functions
;"Kevin Toppenberg MD
;"GNU General Public License (GPL) applies
;"10-15-2007
;"=======================================================================
;" API -- Public Functions.
;"=======================================================================
;"Edit50(IEN50) -- launch a screenman form that is designed to edit file 50 records
;"Index101d44(RxSet,pIndex) -- index pointers from 101.44 --> 101.43
;"GetOI(IEN50d7,Array) -- return linked IEN in the ORDERABLE ITEM file (101.43) from IEN50d7
;"GetPOI(IEN101d43,POI) -- return linked IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
;"$$GetOQVIENS(IEN101d43,RxSet,Array) -- get IEN ORDER QUICK VIEW (101.44) for pointer to 101.43
;"GetOIInfo(IEN101d43,Array) -- Get info about ORDERABLE ITEM (101.43) record
;"ChkFixOI(Array) -- check and fix pointers into and out of OI record
;"GetDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in PHARMACY ORDERABLE ITEM, return linked #50 IEN
;"GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in POI, return linked IEN to DRUG file (50)
;"GetfdaIEN(IEN50) -- return the IEN in 22706.9 that points to IEN50
;"GetFDA(IEN50,FDA) -- For a given IEN in DRUG file, return linked IEN in TMG FDA IMPORT COMPILED file (22706.9)
;"Unlock50: Unlock fields needed to add data to 50
;"Lock50: Return locks removed from Unlock50 in file 50
;"GetpTMG(IEN50d7,TMGArray,ActiveOnly) IENs in 22706.9 pointing to POI (50.7) record
;"Getp1TMG(IEN101d43,TMGArray,ActiveOnly) -- IENS in 22706.9 pointing to OI (101.43) record
;"GetpPOI(IEN50d7,Array,ActiveOnly) -- return all IENs pointing to POI from 22706.9, 50, or 101.43
;"GetpOI(IEN101d43,Array,ActiveOnly) --return all IENs pointing to OI from 22706.9, 50.7 101.44
;"KillPOI(IEN50d7) -- remove a POI, along with ptrs from 50, 22706.9, 101.43
;"KillOI(IEN101d43) -- remove an OI, along with ptrs to it from files 50.7, 22706.9, 101.44
;"RedirOI(oldIEN,newIEN) -- redirect pointers in ORDERABLE ITEM file from oldIEN to newIEN
;"FindPOI(DrugNAF) -- return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name
;"FindOI(DrugNAF) -- return IEN in ORDERABLE ITEM (101.43) matching drug name
;"GetOQVSet(quiet) -- get the active RxSet in OQV file
;"Kill50(IEN50,IEN22706d9,mode,quiet) --delete entry in file 50, and links to it from 22706.9
;"$$OIInactive(IEN101d43) -- Return if record has a past-due inactive date
;"$$IsImport(IEN50d7) -- determine if the POI record is one linked to a FDA import
;"KillOQV(IENS) -- kill/inactivate entry in ORDER QUICK VIEW (101.44)
;"=======================================================================
;" Private Functions.
;"=======================================================================
;"=======================================================================
Edit50(IEN50)
;"Purpose: to launch a screenman form that is designed to edit file 50 records
new PSSZ set PSSZ=1 ;"allows editing of .01 field of file 50
if +IEN50>0 do LaunchScreenman^TMGMISC(50,103,IEN50,1) ;"launch screenman form
quit
Index101d44(RxSet,pIndex)
;"Purpose: index pointers from 101.44 --> 101.43
;"Input: RxSet -the IEN in 101.44 containing ORWDSET O RX
;" pIndex: PASS BY NAME. An OUT PARAMETER. Format:
;" @pIndex@(IEN101.43,IEN101.44)=""
new Itr,subIEN
new abort set abort=0
write "Gathering list of links between ORDER QUICK VIEW --> ORDERABLE ITEM...",!
set subIEN=$$ItrAInit^TMGITR("^ORD(101.44,"_RxSet_",20)",.Itr)
do PrepProgress^TMGITR(.Itr,20,1,"subIEN")
if subIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.subIEN)="")!abort
. if $$UserAborted^TMGUSRIF set abort=1 quit
. new IEN101d43
. set IEN101d43=+$piece($get(^ORD(101.44,RxSet,20,subIEN,0)),"^",1)
. if IEN101d43=0 quit
. set @pIndex@(IEN101d43,subIEN)=1
do ProgressDone^TMGITR(.Itr)
quit
GetOI(IEN50d7,Array)
;"Purpose: for a given PHARAMCY ORDERABLE ITEM (50.7), return matching IEN
;" in the ORDERABLE ITEM file (101.43)
;"Input: IEN50d7 -- the IEN in 50.7
;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER.
;" Will be filled with ALL pointers to 50d7. Format:
;" Array(IEN)=""
;"Results: the IEN in 101.43, or 0 if not found
;"Note: If, for some reason, more than one record in 101.43 points to
;" the specified IEN50d7, then only the first one in the list will be
;" returned, but Array will return all
new result set result=0
new tempS set tempS=IEN50d7_";99PSP"
new IEN101d43 set IEN101d43=""
for set IEN101d43=$order(^ORD(101.43,"ID",tempS,IEN101d43)) quit:(IEN101d43="") do
. if +IEN101d43=0 quit
. if result=0 set result=IEN101d43
. set Array(IEN101d43)=""
quit result
GetPOI(IEN101d43) ;" !! Note: this is a different function from GetpOI !!
;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching
;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
;"Input: IEN101d43 -- IEN in 101.43
;"Output: bad pointers may be fixed.
;"Result: returns IEN in 50.7, or -1 if NON-PHARMACY entry found, or 0 if problem
new Array,result
do GetOIInfo(IEN101d43,.Array)
new tPOI,gPOI
set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE"))
set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC"))
if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do
. do ChkFixOI(.Array)
set result=$get(Array("IEN 50.7 from 22706.9","GENERIC"))
if result="" set result=$get(Array("IEN 50.7 from 22706.9","TRADE"))
if result="" set result=$get(Array("IEN 50.7 from 101.43"))
quit +result
GetOIInfo(IEN101d43,Array)
;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching
;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
;"Input: IEN101d43 -- IEN in 101.43
;" Array -- OPTIONAL. PASS BY REFERENCE. An OUT PARAMETER. Output format:
;" Array("IEN 101.43")=IEN
;" Array("IEN 101.43","NAME")=Name
;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated)
;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy)
;" Array("IEN 101.44",IENS)=""
;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7
;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7
;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7
;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7
;" Array("IEN 50.7 from 101.43")=IEN50d7
;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "" if problem
;" Array("IEN 22706.9","GENERIC",IEN22706d9)=""
;" Array("IEN 22706.9","TRADE",IEN22706d9)=""
;"Output: See Array above.
;"Result: none
new POIName set POIName=""
new IEN22706d9
set Array("IEN 101.43")=IEN101d43
set Array("IEN 101.43","NAME")=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1)
set Array("IEN 101.43","INACTIVE")=$$OIInactive(IEN101d43)
set IEN22706d9=""
for set IEN22706d9=+$order(^TMG(22706.9,"OIG",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do
. if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP
. new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;" 8;4 =POI GENERIC LINK
. set Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=tempPtr
. set Array("IEN 22706.9","GENERIC",IEN22706d9)=""
. set Array("IEN 50.7 from 22706.9","GENERIC")=tempPtr
set IEN22706d9=""
for set IEN22706d9=+$order(^TMG(22706.9,"OIT",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do
. if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP
. new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;" 8;3 = POI TRADENAME LINK
. set Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=tempPtr
. set Array("IEN 22706.9","TRADE",IEN22706d9)=""
. set Array("IEN 50.7 from 22706.9","TRADE")=tempPtr
;"Get direct pointer to 50.7
new ID set ID=$piece($get(^ORD(101.43,IEN101d43,0)),"^",2)
new pkg set pkg=$piece(ID,";",2)
set Array("IEN 101.43","PACKAGE")=pkg
new IEN50d7
if pkg="99PSP" do
. set IEN50d7=+$piece(ID,";",1)
. set POIName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1)
else do goto GPOIDone ;"not a pharmacy item.
. set IEN50d7=0
. set POIName=""
set Array("IEN 50.7 from 101.43")=IEN50d7
set Array("IEN 50.7 from 101.43","NAME")=POIName
new IENS set IENS=$$GetOQVIENS(IEN101d43)
set Array("IEN 101.44",IENS)=""
GPOIDone
quit
ChkFixOI(Array) ;"NOTE: This function is not finished/debugged
;"Purpose: to check and fix pointers into and out of OI record
;"Input -- Array -- PASS BY REFERENCE. An Array as created by GetOIInfo
;" Array("IEN 101.43")=IEN
;" Array("IEN 101.43","NAME")=Name
;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated)
;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy)
;" Array("IEN 101.44",IENS)=""
;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7
;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7
;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7
;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7
;" Array("IEN 50.7 from 101.43")=IEN50d7
;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "" if problem
;" Array("IEN 22706.9","GENERIC",IEN22706d9)=""
;" Array("IEN 22706.9","TRADE",IEN22706d9)=""
;"Result: none
if $get(Array("IEN 101.43","INACTIVE"))=1 goto COIFDone
new IEN101d43 set IEN101d43=+$get(Array("IEN 101.43"))
new IEN50d7a set IEN50d7a=+$get(Array("IEN 50.7 from 101.43"))
if IEN50d7a=0 do KillOI(IENE101d43) goto COIFDone
new POIName set POIName=$get(Array("IEN 50.7 from 101.43","NAME"))
new OIName set OIName=$get(Array("IEN 101.43","NAME"))
new tPOI,gPOI
set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE"))
set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC"))
;"For a given OI, see if there are two different POI's pointing to it via 22706.9
;"There should be just TRADE ptrs or GENERIC ptrs, but not both.
if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do goto COIFDone ;"we have crossed chains.
. ;"We need to make a new POI. But which chain gets new one?
. new gPOIName,tPOIName,OIName
. set gPOIName=$piece($get(^PS(50.7,gPOI,0)),"^",1)
. set tPOIName=$piece($get(^PS(50.7,tPOI,0)),"^",1)
. set OIName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1)
. if gPOIName'=OIName do ;"make a new OI for generic chain
. . new newOI set newOI=$$NewOI^TMGNDF4C(gPOIName)
. . if newOI=0 quit ;"error
. . new result set result=$$StuffOI^TMGNDF4C(newOI,gPOIName,,gPOI)
. . new IEN22706d9 set IEN22706d9=""
. . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)) quit:(IEN22706d9="") do
. . . new TMGFDA,TMGMSG
. . . set TMGFDA(22706.9,IEN22706d9_",",5.711)=newOI
. . . do FILE^DIE("","TMGFDA","TMGMSG")
. . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
. if tPOIName'=OIName do ;"make a new OI for trade chain
. . new newOI set newOI=$$NewOI^TMGNDF4C(tPOIName)
. . if newOI=0 quit ;"error
. . new result set result=$$StuffOI^TMGNDF4C(newOI,tPOIName,,tPOI)
. . new IEN22706d9 set IEN22706d9=""
. . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)) quit:(IEN22706d9="") do
. . . new TMGFDA,TMGMSG
. . . set TMGFDA(22706.9,IEN22706d9_",",5.611)=newOI
. . . do FILE^DIE("","TMGFDA","TMGMSG")
. . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
if ($data(Array("IEN 50.7 from 22706.9","GENERIC"))=0)&($data(Array("IEN 50.7 from 22706.9","TRADE"))=0) do
. write "A linked record in 22706.9 NOT found pointing to 101.43 #",IEN101d43," (",OIName,")",!
else do
. new TMGIEN set TMGIEN=""
. for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN)) quit:(TMGIEN="") do
. . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN))
. . write "Linked record in 22706.9 #",TMGIEN," (GENERIC pointer) points to 50.7 #",IEN50d7,!
. set TMGIEN=""
. for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN)) quit:(TMGIEN="") do
. . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN))
. . write "Linked record in 22706.9 #",TMGIEN," (TRADE pointer) points to 50.7 #",IEN50d7,!
write " 101.43 #",IEN101d43," (",OIName,")",!
write " points directly to 50.7 #",IEN50d7a," (",POIName,")",!
if (IEN50d7a'=0),$$IsImport^TMGNDF4B(IEN50d7a) do
. write " and that IS an active import record.",!
. new IEN50Array
. do GetDRUGs^TMGNDF4F(IEN50d7a,.IEN50Array,1)
. write " Pointed to by these active records:",!
. new name set name=""
. for set name=$order(IEN50Array(name)) quit:(name="") do
. . new IEN50 set IEN50=""
. . for set IEN50=$order(IEN50Array(name,IEN50)) quit:(IEN50="") do
. . . write " #",IEN50," ",name,!
else do
. write " and that IS NOT active import record.",!
. do KillOI(IEN101d43)
. write " .. Record in 101.43 deleted.",!
COIFDone
quit
GetDRUGs(IEN50d7,IEN50Array,ActiveOnly)
;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to
;" DRUG file (50)
;"Input: IEN50d7 -- IEN in file 50.7
;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" IEN50Array(Name,IEN50)="" Name is from .01 field
;" IEN50Array(Name,IEN50)="" Name is from .01 field
;" ActiveOnly -- OPTIONAL, Default=1
;"result: none.
if +$get(IEN50d7)=0 goto GDsDone
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
. . new name set name=$piece($get(^PSDRUG(tIEN50,0)),"^",1)
. . set IEN50Array(name,tIEN50)=""
. set gIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
. if gIEN50>0 do
. . new name set name=$piece($get(^PSDRUG(gIEN50,0)),"^",1)
. . set IEN50Array(name,gIEN50)=""
;"set ActiveOnly=1
;"kill IEN50Array
;"new temp merge temp=^PSDRUG("ASP",IEN50d7)
;"new IEN set IEN=""
;"for set IEN=$order(temp(IEN)) quit:(IEN="") do
;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="")
;". if ActiveOnly,(Active=0) quit
;". new name set name=$$GET1^DIQ(50,IEN_",",.01) quit:(name="")
;". ;"set name="(#"_IEN_") "_name
;". new route set route=$$GET1^DIQ(50,IEN_",",62.02)
;". if route'="" set name=name_" "_route
;". set IEN50Array(name,IEN)=""
GDsDone
quit
GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly)
;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to
;" DRUG file (50)
;"Input: IEN50d7 -- IEN in file 50.7
;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" IEN50Array(IEN50)=""
;" IEN50Array(IEN50)=""
;" ActiveOnly -- OPTIONAL, Default=1
;"result: none.
set ActiveOnly=$get(ActiveOnly,1)
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
. . if ActiveOnly=1 quit
. . write " Pointer to PHARMACY ORDERABLE ITEM #",IEN50d7," found in skipped 22706.9 #",IEN22706d9," record!",!
. new tIEN50,gIEN50
. set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
. if tIEN50>0 set IEN50Array(tIEN50)=""
. set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
. if gIEN50>0 set IEN50Array(gIEN50)=""
;"set ActiveOnly=1
;"kill IEN50Array
;"new temp merge temp=^PSDRUG("ASP",IEN50d7)
;"new IEN set IEN=""
;"for set IEN=$order(temp(IEN)) quit:(IEN="") do
;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="")
;". if ActiveOnly,(Active=0) quit
;". set IEN50Array(IEN)=""
quit
GetfdaIEN(IEN50)
;"Purpose: to return the pointer to the record in 22706.9 that points to IEN50
;"Input: IEN50 -- IEN in 50
;"Results: returns a pointer, or 0 if not found
new result
set result=+$order(^TMG(22706.9,"DRUG",IEN50,""))
if result=0 set result=+$order(^TMG(22706.9,"DRUGT",IEN50,""))
quit result
GetFDA(IEN50,FDA)
;"Purpose: For a given IEN in DRUG file, return linked IEN in
;" TMG FDA IMPORT COMPILED file (22706.9)
;"Input: IEN50 -- IEN in file 50 (DRUG)
;" FDA -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" FDA=IEN in 22706.9
;" FDA("NAME")=Name
;"result: none.
set FDA=$$GetfdaIEN(IEN50)
if FDA'=0 set FDA("NAME")=$$GET1^DIQ(22706.9,FDA_",",.04)
quit
GetDRUGIEN(IEN50d7) ;" -- DEPRECIATED. Use GetDRUGs^TMGNDFUT or GetpDRUGs^TMGNDFUT
;"Purpose: get linked record in DRUG file (50) for given record in 50.7
;"Input:IEN50d7 -- IEN in 50.7
;"Results: IEN in 50, or 0 if not found
;"NOTE: there may well be MULTIPLE records in 50 pointing to record in 50.7
;" This function will only return the FIRST.
;" GetDRUGs^TMGNDF4F(IEN50d7,IEN50Array,ActiveOnly) -- will return ALL entries.
new result
set result=$order(^PSDRUG("ASP",IEN50d7,""))
quit result
GetpTMG(IEN50d7,TMGArray,ActiveOnly)
;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs
;" in 22706.9 pointing to this
;"Input: IEN50d7 -- IEN in file 50.7
;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" TMGArray(IEN22706d9)=""
;" TMGArray(IEN22706d9)=""
;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
;"result: none.
merge TMGArray=^TMG(22706.9,"POIG",IEN50d7)
merge TMGArray=^TMG(22706.9,"POIT",IEN50d7)
if $get(ActiveOnly)=1 do
. new IEN22706d9 set IEN22706d9=""
. for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
. . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip
. . kill TMGArray(IEN22706d9)
quit
Getp1TMG(IEN101d43,TMGArray,ActiveOnly)
;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs
;" in 22706.9 pointing to this
;"Input: IEN101d43 -- IEN in file 101.43
;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" TMGArray(IEN22706d9)=""
;" TMGArray(IEN22706d9)=""
;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
;"result: none.
merge TMGArray=^TMG(22706.9,"OIG",IEN101d43)
merge TMGArray=^TMG(22706.9,"OIT",IEN101d43)
if $get(ActiveOnly)=1 do
. new IEN22706d9 set IEN22706d9=""
. for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
. . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip
. . kill TMGArray(IEN22706d9)
quit
Unlock50
;"Purpose: Unlock fields needed to add data to 50
kill ^DD(50,20,8.5)
kill ^DD(50,20,9)
kill ^DD(50,21,8.5)
kill ^DD(50,21,9)
kill ^DD(50,22,8.5)
kill ^DD(50,22,9)
kill ^DD(50,25,8.5)
kill ^DD(50,25,9)
kill ^DD(50,29,8.5)
kill ^DD(50,29,9)
kill ^DD(50,902,8.5)
kill ^DD(50,902,9)
new node,nodeA,nodeB,node2
set node=$get(^DD(50,901,0))
set nodeA=$piece(node,"^",1,4)
set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N) X"
set node2=nodeA_"^"_nodeB
set ^DD(50,901,0)=node2
quit
Lock50
;"Purpose: Return locks removed from Unlock50 in file 50
set ^DD(50,20,8.5)="^"
set ^DD(50,20,9)="^"
set ^DD(50,21,8.5)="^"
set ^DD(50,21,9)="^"
set ^DD(50,22,8.5)="^"
set ^DD(50,22,9)="^"
set ^DD(50,25,8.5)="^"
set ^DD(50,25,9)="^"
set ^DD(50,29,8.5)="^"
set ^DD(50,29,9)="^"
set ^DD(50,902,8.5)="^"
set ^DD(50,902,9)="^"
new node,nodeA,nodeB
set node=$get(^DD(50,901,0))
set nodeA=$piece(node,"^",1,4)
set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N)!('$P($G(^PSDRUG(DA,""DOS"")),""^"",2)) X"
set node2=nodeA_"^"_nodeB
set ^DD(50,901,0)=node2
quit
GetpPOI(IEN50d7,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpOI or GetPOI!!
;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs
;" pointing to this, from 22706.9, 50, or 101.43
;"Input: IEN50d7 -- IEN in file 50.7
;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" Array(File,IENS,field)=""
;" Array(File,IENS,field)=""
;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
;" *** NOT FULLY IMPLEMENTED YET ***
;"result: none.
new TMGFDA,TMGMSG
set ActiveOnly=$get(ActiveOnly,0)
;"Get links in 50 to POI record (from 22706.9 Xref)
new IEN50Array
do GetpDRUGs(IEN50d7,.IEN50Array,0)
new IEN50 set IEN50=""
for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="") do
. set Array(50,IEN50_",",2.1)=""
;"Get links in 50 to POI record (from 50 ASP Xref)
new temp merge temp=^PSDRUG("ASP",IEN50d7)
set IEN50=""
for set IEN50=$order(temp(IEN50)) quit:(IEN50="") do
. new Active set Active=($piece($get(^PSDRUG(IEN50,"I")),"^",1)="")
. if (ActiveOnly=1)&(Active=0) quit
. set Array(50,IEN50_",",2.1)=""
;"Get pointers in 22706.9 to POI record
new TMGArray
do GetpTMG(IEN50d7,.TMGArray,ActiveOnly)
new IEN22706d9 set IEN22706d9=""
for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
. if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)=IEN50d7 do
. . set Array(22706.9,IEN22706d9_",",5.61)=""
. if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)=IEN50d7 do
. . set Array(22706.9,IEN22706d9_",",5.71)=""
;"Get text pointers in 101.43 to POI record
new ID set ID=IEN50d7_";99PSP"
new IEN101d43 set IEN101d43=""
for set IEN101d43=$order(^ORD(101.43,"ID",ID,IEN101d43)) quit:(IEN101d43="") do
. set Array(101.43,IEN101d43_",",2)="@"
quit
GetpOI(IEN101d43,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpPOI!!
;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs
;" pointing to this, from 22706.9, 50.7 101.44
;"Input: IEN101d43 -- IEN in file 101.43
;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
;" Array(File,IENS,field)=""
;" Array(File,IENS,field)=""
;" Array(File,IENS,"N/A")="" for 50.7 'pointers'
;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
;" *** NOT FULLY IMPLEMENTED YET ***
;"result: none.
;"Note: there is no direct pointer 50.7 --> 101.43
;" Will use 101.43 <-- 22706.9 --> 50.7 to get 50.7 --> 101.43
new TMGFDA,TMGMSG
set ActiveOnly=$get(ActiveOnly,0)
;"Get Pointers 101.44 --> 101.43
new all
if $$GetOQVIENS(IEN101d43,.all)>0 do
. new IENS set IENS=""
. for set IENS=$order(all(IENS)) quit:(IENS="") do
. . set Array(101.442,IENS,.01)=""
;"Get pointers in 22706.9 to 101.43/OI record
;" use to create pseudo pointers 50.7 --> 101.43
new TMGArray
do Getp1TMG(IEN101d43,.TMGArray,ActiveOnly)
new IEN22706d9 set IEN22706d9=""
for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
. set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;"TRADE POI
. if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")=""
. set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;"GENERIC POI
. if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")=""
;"Get Pointers in 22706.9 --> 101.43
new IEN22706d9 set IEN22706d9=""
for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
. if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)=IEN101d43 do
. . set Array(22706.9,IEN22706d9_",",5.611)=""
. if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)=IEN101d43 do
. . set Array(22706.9,IEN22706d9_",",5.711)=""
quit
RedirOI(oldIEN,newIEN)
;"Purpose: to redirect pointers to ORDERABLE ITEM file from oldIEN to newIEN
;"Input: oldIEN -- IEN in ORDABLE ITEM (101.44) to switch FROM
;" newIEN -- IEN in ORDABLE ITEM (101.44) to switch TO
;"results: none.
new Array
do GetpOI(oldIEN,.Array)
;"redirect pointers to this record held in other files (50.7, 22706.9, or 101.442)
new file set file=""
for set file=$order(Array(file)) quit:(file="") do
. new IENS set IENS=""
. for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
. . new field set field=""
. . for set field=$order(Array(file,IENS,field)) quit:(field="") do
. . . if +field'=field quit ;"avoid "N/A"
. . . new TMGFDA,TMGMSG
. . . set TMGFDA(file,IENS,field)=newIEN
. . . do FILE^DIE("","TMGFDA","TMGMSG")
. . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
quit
FindPOI(DrugNAF)
;"Purpose: to return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name
;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB)
;"results: IEN in 50.7, or 0 if not found
;"Note: this will only return the FIRST such match.
;" Also, this is an EXACT match only.
new result
set result=+$order(^PS(50.7,"B",DrugNAF,""))
quit result
FindOI(DrugNAF)
;"Purpose: to return IEN in ORDERABLE ITEM (101.43) matching drug name
;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB)
;"results: IEN in 101.43, or 0 if not found
;"Note: this will only return the FIRST such match.
;" Also, this is an EXACT match only.
new result
set result=+$order(^ORD(101.43,"B",DrugNAF,""))
quit result
Kill50(IEN50,IEN22706d9,mode,quiet)
;"Purpose: to delete entry in file 50, and also links to it from 22706.9
;"Input: IEN50 -- IEN in file 50
;" IEN22706d9 -- IEn in 22706.9
;" mode -- OPTIONAL-- "TRADE" or "GENERIC"
;" quiet -- OPTIONAL -- 1 = no message
;"Results: none
;"NOTE: Since file 50 is the head of a chain of drugs, it does not make
;" sense for 22706.9 to have a 0 pointer to 50, but still have pointers
;" to other entries in the chain (parts of which might be used by other
;" drugs). So I will also delete pointers to 50.7 and 101.43
;" This could leave dangling records. I guess I will have to deal
;" with this elsewhere.
;" -- I WILL be deleting records in 50.7 (if not pointed to by other drugs)
set IEN50=+$get(IEN50)
if IEN50=0 goto K50Done
set mode=$get(mode)
set quiet=$get(quiet)
;"Get pointer to next link in chain, before deleting this link
new IEN50d7 ;"50.7 = PHARMACY ORDERABLE ITEM.
set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1)
new TMGFDA,TMGMSG
if (IEN50>0)&($data(^PSDRUG(IEN50))>0) do
. set TMGFDA(50,IEN50_",",.01)="@"
. do FILE^DIE("K","TMGFDA","TMGMSG")
. do ShowIfDIERR^TMGDEBUG(.TMGMSG)
. if 'quiet write !,"DRUG entry (#",IEN50,") deleted: ",$get(DrugInfo("NAME",mode))
if mode="" do
. new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
. new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
. if tIEN50=IEN50 set mode="TRADE" quit
. if gIEN50=IEN50 set mode="GENERIC" quit
if mode="TRADE" do
. if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.6)="@"
. . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",!
. if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.61)="@"
. . if 'quiet write " Link to trade POI from import #",IEN22706d9," removed.",!
. if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@"
. . if 'quiet write " Link to trade OI from import #",IEN22706d9," removed.",!
. new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
. if $data(TMGFDA)=0 quit
. do FILE^DIE("K","TMGFDA","TMGMSG")
. do ShowIfDIERR^TMGDEBUG(.TMGMSG)
if mode="GENERIC" do
. if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.7)="@"
. . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",!
. if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.71)="@"
. . if 'quiet write " Link to generic POI from import #",IEN22706d9," removed.",!
. if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)>0 do
. . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@"
. . if 'quiet write " Link to generic OI from import #",IEN22706d9," removed.",!
. new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
. if $data(TMGFDA)=0 quit
. do FILE^DIE("K","TMGFDA","TMGMSG")
. do ShowIfDIERR^TMGDEBUG(.TMGMSG)
;"See if any other DRUGs(50) are pointing to POI (50.7). If not kill POI
if $order(^PSDRUG("ASP",IEN50d7,""))="" do
. do KillPOI(IEN50d7) ;"will link forward to kill the rest of the chain
K50Done quit
KillPOI(IEN50d7)
;"Purpose: to remove a PHARMACY ORDERABLE ITEM (50.7), along with pointers
;" to it from files 50, 22706.9, 101.43
;"NOTE: This function will also call subsequent functions to
;" kill records chained records in 101.43,101.44
;"Results: none
set IEN50d7=+$get(IEN50d7)
if IEN50d7=0 goto KPOIdone
;"Get array of pointers to OI's from this POI record
new OIArray,temp
set temp=$$GetOI(IEN50d7,.OIArray)
new Array
do GetpPOI(IEN50d7,.Array,0)
new PSSZ set PSSZ=1 ;"Key for editing 50 (?)
do Unlock50 ;"if I relock here, may lock another function out. Will leave unlocked
;"Delete pointers to this record held in other files (50, 22706.9, or 101.43)
new file set file=""
for set file=$order(Array(file)) quit:(file="") do
. if file=101.43 quit ;"ignore these, to be handled below
. new IENS set IENS=""
. for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
. . new field set field=""
. . for set field=$order(Array(file,IENS,field)) quit:(field="") do
. . . new TMGFDA,TMGMSG
. . . set TMGFDA(file,IENS,field)="@"
. . . do FILE^DIE("","TMGFDA","TMGMSG")
. . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
;"Delete the record itself.
if $data(^PS(50.7,IEN50d7))'=0 do
. new TMGFDA,TMGMSG
. set TMGFDA(50.7,IEN50d7_",",.01)="@"
. do FILE^DIE("","TMGFDA","TMGMSG")
. do ShowIfDIERR^TMGDEBUG(.TMGMSG)
;"Kill chained records in OI
new IEN101d43 set IEN101d43=""
for set IEN101d43=$order(OIArray(IEN101d43)) quit:(IEN101d43="") do
. do KillOI(IEN101d43) ;"Will chain forward to delete further records in chain.
KPOIdone
quit
KillOI(IEN101d43)
;"Purpose: to remove an ORDERABLE ITEM, along with pointers to it
;" from files 50.7, 22706.9, 101.44
;"Results: none
set IEN101d43=+$get(IEN101d43)
if IEN101d43=0 goto KOIDone
new Array
do GetpOI(IEN101d43,.Array,0)
;"Delete pointers to this record held in other files (50.7, 22706.9, or 101.442)
new file set file=""
for set file=$order(Array(file)) quit:(file="") do
. if file=101.442 quit ;" ignore these... will handle below
. new IENS set IENS=""
. for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
. . new field set field=""
. . for set field=$order(Array(file,IENS,field)) quit:(field="") do
. . . if +field'=field quit ;"avoid "N/A"
. . . new TMGFDA,TMGMSG
. . . set TMGFDA(file,IENS,field)="@"
. . . do FILE^DIE("","TMGFDA","TMGMSG")
. . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
;"Delete record in 101.43
if $data(^ORD(101.43,IEN101d43))'=0 do
. new TMGFDA,TMGMSG
. set TMGFDA(101.43,IEN101d43_",",.01)="@"
. do FILE^DIE("","TMGFDA","TMGMSG")
. do ShowIfDIERR^TMGDEBUG(.TMGMSG)
;"Delete chained records in 101.44
new OQVIENS set OQVIENS=""
for set OQVIENS=$order(Array(101.442,OQVIENS)) quit:(OQVIENS="") do
. do KillOQV(OQVIENS)
KOIDone quit
KillOQV(IENS)
;"Purpose: to kill/inactivate entry in ORDER QUICK VIEW (101.44)
;"Input: IENS -- the IENS entry locating record to 'kill'
;"Results: none
;"Note: for now, I am not going to actually delete the record, just
;" mark it as deleted
new TMGFDA,TMGMSG
set TMGFDA(101.442,IENS,.01)=0
set TMGFDA(101.442,IENS,2)=""
do FILE^DIE("","TMGFDA","TMGMSG")
do ShowIfDIERR^TMGDEBUG(.TMGMSG)
quit
GetOQVIENS(IEN101d43,RxSet,Array)
;"Purpose: Scan in ORDER QUICK VIEW (101.44) for pointer to 101.43
;"Input: IEN101d43 -- IEN in ORDERABLE ITEM (101.43) file
;" RxSet -- OPTIONAL -- the IEN of the ORWDSET O RX record in 101.44
;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER.
;" Will be filled with ALL pointers to 101.43. Format:
;" Array(IENS)=""
;"Result: IENS pointing to Entry in OQV (e.g. '104,57,'), or 0 if not found
;"If there happened to be 2 pointers to 101.43, this would only return
;" the FIRST one, but Array will return all pointers.
;"On my initial run index was empty. May need to programatically launch reindex in the future
new result set result=0
if +$get(RxSet)=0 set RxSet=$$GetOQVSet
if RxSet=0 goto GPrDone
new IENS set IENS=""
new OQVIEN set OQVIEN=""
for set OQVIEN=$order(^ORD(101.44,RxSet,20,"B",IEN101d43,OQVIEN)) quit:(OQVIEN="") do
. if +OQVIEN=0 quit
. new tempIENS set tempIENS=OQVIEN_","_RxSet_","
. if result=0 set result=tempIENS
. set Array(tempIENS)=""
GPrDone quit result
GetOQVSet(quiet)
;"Purpose: get the active RxSet in ORDER QUICK VIEW (101.44)
;"Input: quiet -- OPTIONAL. If 1, then no error message
;"results: returns RxSet, or 0 if problem.
set quiet=+$get(quiet)
new DIC,X,Y
set DIC=101.44
set X="ORWDSET O RX"
do ^DIC
if +Y'>0 do
. if quiet quit
. write "Can't find record 'ORWDSET O RX' in ORDER QUICK VIEW (101.44) file.",!
quit +Y
OIInactive(IEN101d43)
;"Purpose -- Return if record has a past-due inactive date
;"Input: IEN101d43 -- IEn in 101.43
;"Results: 0 -- not inactive, 1 is inactive
new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1)
new pastInactiveDate set pastInactiveDate=0
if date'="" do
. new X,Y set X="NOW" do ^%DT ;"results in Y
. new X1,X2
. set X1=Y,X2=date
. do ^%DTC ;"result is X=X1-X2 (X=NOW-InactiveDate) X>-1 means past inactive date
. set pastInactiveDate=(X>-1)
quit pastInactiveDate
IsImport(IEN50d7)
;"Purpose: To determine if the POI record is one linked to a FDA import
;"Input: IEN50d7 -- IEN in 50.7
;"Results: 1 if linked to a DRUG entry that is linked to an NON-SKIPPED
;" record in 22706.9
;" 0 otherwise
;"Addendum: This function will be changed slightly, to such that it returns
;" 1 if linked to an entry in 22706.9 that is NON-SKIPPED
new result set result=0
new IEN22706d9 set IEN22706d9=""
for set IEN22706d9=$order(^TMG(22706.9,"POIT",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do
. if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1
if result=1 goto IIDone
for set IEN22706d9=$order(^TMG(22706.9,"POIG",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do
. if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1
goto IIDone
;"==== old code, delete later
new result set result=0
new IEN50Array
do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array,1)
new IEN50 set IEN50=""
for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="")!(result=1) do
. new fdaIEN set fdaIEN=$$GetfdaIEN^TMGNDFUT(IEN50) if fdaIEN'>0 quit
. if $piece($get(^TMG(22706.9,fdaIEN,1)),"^",4)'=1 set result=1
IIDone
quit result