Globals from FOIA VistA with corrected Node problem for the cross references in the mental health files for C and AU
Cache 13-Sep-2008 18:35:03 ZWR
^MAGD(2006.5715,0)="CURRENT IMAGE^2006.5715^^"
^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575^^"
^MAGD(2006.599,0)="DICOM Error Log^2006.599^^"
^MAGD(2006.79,0)="DICOM ROUTINE COPY^2006.79^30^30"
^MAGD(2006.79,1,0)="MCUIMAG0^3050311.125836"
^MAGD(2006.79,1,1,0)="^2006.791^242^242"
^MAGD(2006.79,1,1,1,0)="MCUIMAG0 ;HCIOFO/DAD-Create / Update Med Procedure with Image Pointer ;7/23/97  07:36"
^MAGD(2006.79,1,1,2,0)=" ;;2.3;Medicine;**7,12**;09/13/1996"
^MAGD(2006.79,1,1,3,0)=" Q"
^MAGD(2006.79,1,1,4,0)=" ;"
^MAGD(2006.79,1,1,5,0)="UPDATE(MCDATE,MCPROCD0,MCDFN,MCMAGPTR,MCD0,OK) ;"
^MAGD(2006.79,1,1,6,0)=" ; *** Main driver to update Medicine files from Imaging ***"
^MAGD(2006.79,1,1,7,0)=" ;  MCDATE = Date/Time of procedure (FM internal format)"
^MAGD(2006.79,1,1,8,0)=" ;  MCPROCD0 = Pointer to the Procedure/Subspecialty file (#697.2)"
^MAGD(2006.79,1,1,9,0)=" ;  MCDFN = Pointer to the Patient file (#2)"
^MAGD(2006.79,1,1,10,0)=" ;  MCMAGPTR() = An array whose subscripts are pointers to the Image"
^MAGD(2006.79,1,1,11,0)=" ;               file (#2005)  Returned as: MCMAGPTR(File 2005 IEN)="
^MAGD(2006.79,1,1,12,0)=" ;               MCFILE ^ MCD0 ^ MCD1 (IEN of image in image mult)"
^MAGD(2006.79,1,1,13,0)=" ;  MCD0 = Pointer to one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,14,0)=" ;  OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
^MAGD(2006.79,1,1,15,0)=" N DD,DIC,DINUM,DO,MCPATFLD,X,Y"
^MAGD(2006.79,1,1,16,0)=" S MCDATE=+$G(MCDATE),MCPROCD0=+$G(MCPROCD0)"
^MAGD(2006.79,1,1,17,0)=" S MCDFN=+$G(MCDFN),MCD0=+$G(MCD0)"
^MAGD(2006.79,1,1,18,0)=" S MCFILE=+$P($P($G(^MCAR(697.2,MCPROCD0,0)),U,2),""("",2)"
^MAGD(2006.79,1,1,19,0)=" I MCFILE'>0 D  Q"
^MAGD(2006.79,1,1,20,0)=" . S OK=""0^Medicine Procedure file global location not found"""
^MAGD(2006.79,1,1,21,0)=" . Q"
^MAGD(2006.79,1,1,22,0)=" S MCPATFLD=$$PATFLD(MCFILE)"
^MAGD(2006.79,1,1,23,0)=" I MCPATFLD'>0 D  Q"
^MAGD(2006.79,1,1,24,0)=" . S OK=""0^Medical Patient field not found in Medicine Procedure file"""
^MAGD(2006.79,1,1,25,0)=" . Q"
^MAGD(2006.79,1,1,26,0)=" I MCD0>0 S OK=$$VALID(MCFILE,MCD0,MCDFN,MCPROCD0) Q:'OK"
^MAGD(2006.79,1,1,27,0)=" I MCD0'>0 D  Q:'OK"
^MAGD(2006.79,1,1,28,0)=" . N MCIEN S MCIEN=0"
^MAGD(2006.79,1,1,29,0)=" . F  S MCIEN=$O(^MCAR(MCFILE,""B"",MCDATE,MCIEN)) Q:MCIEN'>0  D  Q:MCD0"
^MAGD(2006.79,1,1,30,0)=" .. S OK=$$VALID(MCFILE,MCIEN,MCDFN,MCPROCD0)"
^MAGD(2006.79,1,1,31,0)=" .. I OK S MCD0=MCIEN"
^MAGD(2006.79,1,1,32,0)=" .. Q"
^MAGD(2006.79,1,1,33,0)=" . I MCD0'>0 D NEW(MCDATE,MCDFN,MCFILE,MCPROCD0,MCPATFLD,.MCD0,.OK)"
^MAGD(2006.79,1,1,34,0)=" . Q"
^MAGD(2006.79,1,1,35,0)=" I $O(MCMAGPTR(0)) D FILE(MCD0,MCFILE,.MCMAGPTR,.OK) Q:'OK"
^MAGD(2006.79,1,1,36,0)=" S MCD0=MCD0_U_MCFILE"
^MAGD(2006.79,1,1,37,0)=" Q"
^MAGD(2006.79,1,1,38,0)=" ;"
^MAGD(2006.79,1,1,39,0)="NEW(MCDATE,MCDFN,MCFILE,MCPROCD0,MCPATFLD,MCD0,OK) ;"
^MAGD(2006.79,1,1,40,0)=" ; *** Create new Medicine patient (if needed) and procedure records ***"
^MAGD(2006.79,1,1,41,0)=" ;  MCDATE = Date/Time of procedure (FM internal format)"
^MAGD(2006.79,1,1,42,0)=" ;  MCDFN = Pointer to the Patient file (#2)"
^MAGD(2006.79,1,1,43,0)=" ;  MCFILE = File number of one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,44,0)=" ;  MCPROCD0 = Pointer to the Procedure/Subspecialty file (#697.2)"
^MAGD(2006.79,1,1,45,0)=" ;  MCPATFLD = Field# in one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,46,0)=" ;             that points to the Medical Patient file (#690)"
^MAGD(2006.79,1,1,47,0)=" ;  MCD0 = Pointer to one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,48,0)=" ;  OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
^MAGD(2006.79,1,1,49,0)=" N DD,DIC,DINUM,DLAYGO,DO,MCARCODE,MCPRCFLD,MCRESULT,X,Y"
^MAGD(2006.79,1,1,50,0)=" S OK=""1^New stub record created in Medicine Procedure data file"""
^MAGD(2006.79,1,1,51,0)=" ; *** Create a new record in the Medical Patient file (#690) ***"
^MAGD(2006.79,1,1,52,0)=" I '$D(^MCAR(690,MCDFN)) D  Q:'OK"
^MAGD(2006.79,1,1,53,0)=" . K DD,DIC,DINUM,DO"
^MAGD(2006.79,1,1,54,0)=" . S (X,DINUM)=MCDFN,DLAYGO=690"
^MAGD(2006.79,1,1,55,0)=" . S DIC=""^MCAR(690,"",DIC(0)=""L"""
^MAGD(2006.79,1,1,56,0)=" . D FILE^DICN"
^MAGD(2006.79,1,1,57,0)=" . I Y'>0 D"
^MAGD(2006.79,1,1,58,0)=" .. S OK=""0^Cannot add patient to Medical Patient file"""
^MAGD(2006.79,1,1,59,0)=" .. Q"
^MAGD(2006.79,1,1,60,0)=" . Q"
^MAGD(2006.79,1,1,61,0)=" ; *** Create a stub record ***"
^MAGD(2006.79,1,1,62,0)=" K DD,DIC,DINUM,DO"
^MAGD(2006.79,1,1,63,0)=" S DIC=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")"
^MAGD(2006.79,1,1,64,0)=" S DIC(0)=""L"",DLAYGO=MCFILE"
^MAGD(2006.79,1,1,65,0)=" S DIC(""DR"")=MCPATFLD_""///`""_MCDFN"
^MAGD(2006.79,1,1,66,0)=" S MCARCODE=$P($G(^MCAR(697.2,MCPROCD0,0)),U,4) S:MCARCODE="""" MCARCODE=U"
^MAGD(2006.79,1,1,67,0)=" S MCPRCFLD=$$PRCFLD(MCFILE)"
^MAGD(2006.79,1,1,68,0)=" I MCPRCFLD>0 D PRCSUBS Q:'OK"
^MAGD(2006.79,1,1,69,0)=" S X=MCDATE"
^MAGD(2006.79,1,1,70,0)=" D FILE^DICN S MCD0=+Y"
^MAGD(2006.79,1,1,71,0)=" I MCD0'>0 D"
^MAGD(2006.79,1,1,72,0)=" . S OK=""0^Cannot create stub record in the Medicine Procedure data file"""
^MAGD(2006.79,1,1,73,0)=" . Q"
^MAGD(2006.79,1,1,74,0)=" Q"
^MAGD(2006.79,1,1,75,0)=" ;"
^MAGD(2006.79,1,1,76,0)="FILE(MCD0,MCFILE,MCMAGPTR,OK) ;"
^MAGD(2006.79,1,1,77,0)=" ; *** Store the Image file (#2005) pointers in Med Proc data files ***"
^MAGD(2006.79,1,1,78,0)=" ;  MCD0 = Pointer to one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,79,0)=" ;  MCFILE = File number of one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,80,0)=" ;  MCMAGPTR() = An array whose subscripts are pointers to the Image"
^MAGD(2006.79,1,1,81,0)=" ;               file (#2005)  Returned as: MCMAGPTR(File 2005 IEN)="
^MAGD(2006.79,1,1,82,0)=" ;               MCFILE ^ MCD0 ^ MCD1 (IEN of image in image mult)"
^MAGD(2006.79,1,1,83,0)=" ;  OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
^MAGD(2006.79,1,1,84,0)=" N DD,DIC,DINUM,DLAYGO,DO,MCD1,MCDIC,MCMAGD0,MCNODE,X,Y"
^MAGD(2006.79,1,1,85,0)=" S OK=""1^The Medicine Procedure file has been updated"""
^MAGD(2006.79,1,1,86,0)=" I $O(MCMAGPTR(0))'>0 D  Q"
^MAGD(2006.79,1,1,87,0)=" . S OK=""0^No image number to file in Medicine Procedure file"""
^MAGD(2006.79,1,1,88,0)=" . Q"
^MAGD(2006.79,1,1,89,0)=" I $$VFIELD^DILFD(MCFILE,2005)'>0 D  Q"
^MAGD(2006.79,1,1,90,0)=" . S OK=""0^Image field not found in the Medicine Procedure file"""
^MAGD(2006.79,1,1,91,0)=" . Q"
^MAGD(2006.79,1,1,92,0)=" S MCNODE=$P($$GET1^DID(MCFILE,2005,"""",""GLOBAL SUBSCRIPT LOCATION""),"";"")"
^MAGD(2006.79,1,1,93,0)=" I MCNODE="""" D  Q"
^MAGD(2006.79,1,1,94,0)=" . S OK=""0^Medicine Procedure file global subscript location not found"""
^MAGD(2006.79,1,1,95,0)=" . Q"
^MAGD(2006.79,1,1,96,0)=" S MCDIC=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")_MCD0_"","""
^MAGD(2006.79,1,1,97,0)=" S MCDIC=MCDIC_$S(MCNODE=+MCNODE:MCNODE,1:""""""""_MCNODE_"""""""")_"","""
^MAGD(2006.79,1,1,98,0)=" S MCDIC(""P"")=$$GET1^DID(MCFILE,2005,"""",""SPECIFIER"")"
^MAGD(2006.79,1,1,99,0)=" S MCMAGD0=0"
^MAGD(2006.79,1,1,100,0)=" F  S MCMAGD0=$O(MCMAGPTR(MCMAGD0)) Q:MCMAGD0'>0  D  Q:'OK"
^MAGD(2006.79,1,1,101,0)=" . S MCD1=+$O(^MCAR(MCFILE,MCD0,MCNODE,""B"",MCMAGD0,0))"
^MAGD(2006.79,1,1,102,0)=" . I MCMAGD0'=$P($G(^MCAR(MCFILE,MCD0,MCNODE,MCD1,0)),U) S MCD1=0"
^MAGD(2006.79,1,1,103,0)=" . K DD,DIC,DINUM,DO"
^MAGD(2006.79,1,1,104,0)=" . S DIC=MCDIC,DIC(0)=""L"",DIC(""P"")=MCDIC(""P"")"
^MAGD(2006.79,1,1,105,0)=" . S DLAYGO=MCFILE,(D0,DA(1))=MCD0"
^MAGD(2006.79,1,1,106,0)=" . S X=MCMAGD0"
^MAGD(2006.79,1,1,107,0)=" . I MCD1'>0 D"
^MAGD(2006.79,1,1,108,0)=" .. D FILE^DICN S MCD1=+Y"
^MAGD(2006.79,1,1,109,0)=" .. I MCD1'>0 S OK=""0^Cannot add image to Medicine Procedure file"""
^MAGD(2006.79,1,1,110,0)=" .. Q"
^MAGD(2006.79,1,1,111,0)=" . I OK S MCMAGPTR(MCMAGD0)=MCFILE_U_MCD0_U_MCD1"
^MAGD(2006.79,1,1,112,0)=" . Q"
^MAGD(2006.79,1,1,113,0)=" Q"
^MAGD(2006.79,1,1,114,0)=" ;"
^MAGD(2006.79,1,1,115,0)="VALID(FILE,IEN,DFN,PRC) ;"
^MAGD(2006.79,1,1,116,0)=" ; *** Make sure we have the right Medicine Procedure data file rec ***"
^MAGD(2006.79,1,1,117,0)=" ;  FILE = File number of one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,118,0)=" ;  IEN = Pointer to one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,119,0)=" ;  DFN = Pointer to the Patient file (#2)"
^MAGD(2006.79,1,1,120,0)=" ;  PRC = Pointer to the Procedure/Subspecialty file (#697.2)"
^MAGD(2006.79,1,1,121,0)=" ; Returns"
^MAGD(2006.79,1,1,122,0)=" ;  '1^Message' = All is well, '0^Message' = Bad news"
^MAGD(2006.79,1,1,123,0)=" N FIELD,OK,TYPE"
^MAGD(2006.79,1,1,124,0)=" S OK=""1^Record match found"""
^MAGD(2006.79,1,1,125,0)=" S FIELD=$$PATFLD(FILE)"
^MAGD(2006.79,1,1,126,0)=" I FIELD,$$GET1^DIQ(FILE,IEN,FIELD,""I"")'=DFN D"
^MAGD(2006.79,1,1,127,0)=" . S OK=""0^Patient mismatch"""
^MAGD(2006.79,1,1,128,0)=" . Q"
^MAGD(2006.79,1,1,129,0)=" S FIELD=$$PRCFLD(FILE),TYPE=$$PRCTYPE(PRC)"
^MAGD(2006.79,1,1,130,0)=" ; *** Old Generalized Procedures module and other modules"
^MAGD(2006.79,1,1,131,0)=" I (MCFILE'=699.5)!((MCFILE=699.5)&($$VFILE^DILFD(MCFILE,.06)'>0)) D"
^MAGD(2006.79,1,1,132,0)=" . S FIELD=$P(FIELD,U)"
^MAGD(2006.79,1,1,133,0)=" . Q"
^MAGD(2006.79,1,1,134,0)=" ; *** New Generalized Procedures module"
^MAGD(2006.79,1,1,135,0)=" I (MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)>0) D"
^MAGD(2006.79,1,1,136,0)=" . S FIELD=$S(TYPE=""S"":$P(FIELD,U),TYPE=""P"":$P(FIELD,U,2),1:0)"
^MAGD(2006.79,1,1,137,0)=" . Q"
^MAGD(2006.79,1,1,138,0)=" I FIELD,$$GET1^DIQ(FILE,IEN,FIELD,""I"")'=PRC D"
^MAGD(2006.79,1,1,139,0)=" . S OK=""0^Procedure/Subspecialty mismatch"""
^MAGD(2006.79,1,1,140,0)=" . Q"
^MAGD(2006.79,1,1,141,0)=" Q OK"
^MAGD(2006.79,1,1,142,0)=" ;"
^MAGD(2006.79,1,1,143,0)="PRCFLD(FILE) ;"
^MAGD(2006.79,1,1,144,0)=" ; *** Procedure/Subspecialty pointer field ***"
^MAGD(2006.79,1,1,145,0)=" ;  FILE = File number of one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,146,0)=" ; Returns"
^MAGD(2006.79,1,1,147,0)=" ;  The field# in one of the Medicine Procedure data files that points"
^MAGD(2006.79,1,1,148,0)=" ;  to the Procedure/Subspecialty file (#690)  (Zero [0] if not found)"
^MAGD(2006.79,1,1,149,0)=" N PRCFLD"
^MAGD(2006.79,1,1,150,0)=" S PRCFLD(694)=2,PRCFLD(694.8)=9,PRCFLD(699)=1,PRCFLD(699.5)="".05^.06"""
^MAGD(2006.79,1,1,151,0)=" Q $G(PRCFLD(FILE),0)"
^MAGD(2006.79,1,1,152,0)=" ;"
^MAGD(2006.79,1,1,153,0)="PATFLD(FILE) ;"
^MAGD(2006.79,1,1,154,0)=" ; *** Medical Patient pointer field ***"
^MAGD(2006.79,1,1,155,0)=" ;  FILE = File number of one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,156,0)=" ; Returns"
^MAGD(2006.79,1,1,157,0)=" ;  The field# in one of the Medicine Procedure data files that points"
^MAGD(2006.79,1,1,158,0)=" ;  to the Medical Patient file (#690)  (Zero [0] if not found)"
^MAGD(2006.79,1,1,159,0)=" N MEDPAT"
^MAGD(2006.79,1,1,160,0)=" S MEDPAT(691)=1,MEDPAT(691.1)=1,MEDPAT(691.5)=1,MEDPAT(691.6)=1"
^MAGD(2006.79,1,1,161,0)=" S MEDPAT(691.7)=1,MEDPAT(691.8)=1,MEDPAT(694)=1,MEDPAT(694.5)=1"
^MAGD(2006.79,1,1,162,0)=" S MEDPAT(698)=1,MEDPAT(698.1)=1,MEDPAT(698.2)=1,MEDPAT(698.3)=1"
^MAGD(2006.79,1,1,163,0)=" S MEDPAT(699)=.02,MEDPAT(699.5)=.02,MEDPAT(700)=1,MEDPAT(701)=1"
^MAGD(2006.79,1,1,164,0)=" Q $G(MEDPAT(FILE),0)"
^MAGD(2006.79,1,1,165,0)=" ;"
^MAGD(2006.79,1,1,166,0)="PRCSUBS ; *** Procedure/Subspecialty DIC(""DR"") builder ***"
^MAGD(2006.79,1,1,167,0)=" ; *** Old Generalized Procedures module and other modules"
^MAGD(2006.79,1,1,168,0)=" N MCGENPRC,MCGENSUB,MCPRCTYP"
^MAGD(2006.79,1,1,169,0)=" I (MCFILE'=699.5)!((MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)'>0)) D"
^MAGD(2006.79,1,1,170,0)=" . D PRCTEST(MCFILE,$P(MCPRCFLD,U),MCPROCD0,.OK)"
^MAGD(2006.79,1,1,171,0)=" . S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCPROCD0"
^MAGD(2006.79,1,1,172,0)=" . Q"
^MAGD(2006.79,1,1,173,0)=" ; *** New Generalized Procedures module"
^MAGD(2006.79,1,1,174,0)=" I (MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)>0) D"
^MAGD(2006.79,1,1,175,0)=" . S MCGENPRC=$$FINDPRC(""GENERIC PROCEDURE"",""P"")"
^MAGD(2006.79,1,1,176,0)=" . I MCGENPRC'>0 S OK=""0^Entry 'GENERIC PROCEDURE' not found"" Q"
^MAGD(2006.79,1,1,177,0)=" . S MCGENSUB=$$FINDPRC(""GENERIC SUBSPECIALTY"",""S"")"
^MAGD(2006.79,1,1,178,0)=" . I MCGENSUB'>0 S OK=""0^Entry 'GENERIC SUBSPECIALTY' not found"" Q"
^MAGD(2006.79,1,1,179,0)=" . S MCPRCTYP=$$PRCTYPE(MCPROCD0)"
^MAGD(2006.79,1,1,180,0)=" . I ""^P^S^""'[(U_MCPRCTYP_U) S OK=""0^Invalid Procedure/Subspecialty"" Q"
^MAGD(2006.79,1,1,181,0)=" . D PRCTEST(MCFILE,$P(MCPRCFLD,U,$TR(MCPRCTYP,""PS"",""21"")),MCPROCD0,.OK)"
^MAGD(2006.79,1,1,182,0)=" . I MCPRCTYP=""P"" D"
^MAGD(2006.79,1,1,183,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCGENSUB"
^MAGD(2006.79,1,1,184,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U,2)_""///`""_MCPROCD0"
^MAGD(2006.79,1,1,185,0)=" .. Q"
^MAGD(2006.79,1,1,186,0)=" . I MCPRCTYP=""S"" D"
^MAGD(2006.79,1,1,187,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCPROCD0"
^MAGD(2006.79,1,1,188,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U,2)_""///`""_MCGENPRC"
^MAGD(2006.79,1,1,189,0)=" .. Q"
^MAGD(2006.79,1,1,190,0)=" . Q"
^MAGD(2006.79,1,1,191,0)=" Q"
^MAGD(2006.79,1,1,192,0)=" ;"
^MAGD(2006.79,1,1,193,0)="PRCTEST(MCFILE,MCPRCFLD,MCPROCD0,OK) ;"
^MAGD(2006.79,1,1,194,0)=" ; *** Test for valid procedure"
^MAGD(2006.79,1,1,195,0)=" N MCRESULT"
^MAGD(2006.79,1,1,196,0)=" D CHK^DIE(MCFILE,MCPRCFLD,"""",""`""_MCPROCD0,.MCRESULT)"
^MAGD(2006.79,1,1,197,0)=" K ^TMP(""DIERR"",$J)"
^MAGD(2006.79,1,1,198,0)=" I MCRESULT=U S OK=""0^Procedure is invalid"""
^MAGD(2006.79,1,1,199,0)=" Q"
^MAGD(2006.79,1,1,200,0)=" ;"
^MAGD(2006.79,1,1,201,0)="PRCTYPE(MCPROCD0) ;"
^MAGD(2006.79,1,1,202,0)=" ; *** Return the procedure type ***"
^MAGD(2006.79,1,1,203,0)=" Q $P($G(^MCAR(697.2,MCPROCD0,1)),U)"
^MAGD(2006.79,1,1,204,0)=" ;"
^MAGD(2006.79,1,1,205,0)="FINDPRC(MCENTRY,MCTYPE) ;"
^MAGD(2006.79,1,1,206,0)=" ; *** Find a procedure ***"
^MAGD(2006.79,1,1,207,0)=" ;  MCENTRY = External name of the entry (697.2,.01)"
^MAGD(2006.79,1,1,208,0)=" ;  MCTYPE  = Internal 'Procedure/Subspecialty' type (697.2,1001)"
^MAGD(2006.79,1,1,209,0)=" ; Returns"
^MAGD(2006.79,1,1,210,0)=" ;  The IEN of the procedure or zero if not found."
^MAGD(2006.79,1,1,211,0)=" N MCFOUND,MCIEN"
^MAGD(2006.79,1,1,212,0)=" S (MCIEN,MCFOUND)=0"
^MAGD(2006.79,1,1,213,0)=" F  S MCIEN=$O(^MCAR(697.2,""B"",MCENTRY,MCIEN)) Q:MCIEN'>0  D  Q:MCFOUND"
^MAGD(2006.79,1,1,214,0)=" . I $P($G(^MCAR(697.2,MCIEN,0)),U)=MCENTRY D"
^MAGD(2006.79,1,1,215,0)=" .. I $P($G(^MCAR(697.2,MCIEN,1)),U)=MCTYPE S MCFOUND=1"
^MAGD(2006.79,1,1,216,0)=" .. Q"
^MAGD(2006.79,1,1,217,0)=" . Q"
^MAGD(2006.79,1,1,218,0)=" Q +MCIEN"
^MAGD(2006.79,1,1,219,0)=" ;"
^MAGD(2006.79,1,1,220,0)="KILL(MCFILE,MCD0,MCD1,OK) ;"
^MAGD(2006.79,1,1,221,0)=" ; *** Remove an image from Image multiple ***"
^MAGD(2006.79,1,1,222,0)=" ;  MCFILE = A Medicine Procedure data file number"
^MAGD(2006.79,1,1,223,0)=" ;  MCD0 = Pointer to one of the Medicine Procedure data files"
^MAGD(2006.79,1,1,224,0)=" ;  MCD1 = Pointer to one of the entries in the in the Image multiple"
^MAGD(2006.79,1,1,225,0)=" ;  OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
^MAGD(2006.79,1,1,226,0)=" N D0,D1,DA,DIK,MCNODE"
^MAGD(2006.79,1,1,227,0)=" S OK=""1^Image pointer deleted from Medicine Procedure file"""
^MAGD(2006.79,1,1,228,0)=" I $$VFIELD^DILFD(MCFILE,2005)'>0 D  Q"
^MAGD(2006.79,1,1,229,0)=" . S OK=""0^Image field not found in the Medicine Procedure file"""
^MAGD(2006.79,1,1,230,0)=" . Q"
^MAGD(2006.79,1,1,231,0)=" S DIK=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")"
^MAGD(2006.79,1,1,232,0)=" I DIK="""" D  Q"
^MAGD(2006.79,1,1,233,0)=" . S OK=""0^Medicine Procedure file global name not found"""
^MAGD(2006.79,1,1,234,0)=" . Q"
^MAGD(2006.79,1,1,235,0)=" S MCNODE=$P($$GET1^DID(MCFILE,2005,"""",""GLOBAL SUBSCRIPT LOCATION""),"";"")"
^MAGD(2006.79,1,1,236,0)=" I MCNODE="""" D  Q"
^MAGD(2006.79,1,1,237,0)=" . S OK=""0^Medicine Procedure file global subscript location not found"""
^MAGD(2006.79,1,1,238,0)=" . Q"
^MAGD(2006.79,1,1,239,0)=" S DIK=DIK_MCD0_"",""_$S(MCNODE=+MCNODE:MCNODE,1:""""""""_MCNODE_"""""""")_"","""
^MAGD(2006.79,1,1,240,0)=" S (D0,DA(1))=MCD0,(D1,DA)=MCD1"
^MAGD(2006.79,1,1,241,0)=" D ^DIK"
^MAGD(2006.79,1,1,242,0)=" Q"
^MAGD(2006.79,2,0)="RARIC^3050311.125836"
^MAGD(2006.79,2,1,0)="^2006.791^80^80"
^MAGD(2006.79,2,1,1,0)="RARIC ;HISC/FPT AISC/SAW-Radiologic Image Capture and Display Routine ;6/19/97  12:06"
^MAGD(2006.79,2,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**23,27**;Mar 16, 1998"
^MAGD(2006.79,2,1,3,0)=" ;"
^MAGD(2006.79,2,1,4,0)="CREATE ; create new stub entry in file 74"
^MAGD(2006.79,2,1,5,0)=" ; called from ^MAGKEXC, ^MAGKEXC1"
^MAGD(2006.79,2,1,6,0)=" ; If no report entry is created, RARPT will be undefined"
^MAGD(2006.79,2,1,7,0)=" K RARPT"
^MAGD(2006.79,2,1,8,0)=" ; --------------------------------------------------------------------"
^MAGD(2006.79,2,1,9,0)=" ; Perform data validation checks for the following 'RA' namespaced"
^MAGD(2006.79,2,1,10,0)=" ; variables: RADTE, RADFN, RADTI, RACN & RACNI (all should be defined)"
^MAGD(2006.79,2,1,11,0)=" Q:'$D(RADTE)!('$D(RADFN))!('$D(RADTI))!('$D(RACN))!('$D(RACNI))"
^MAGD(2006.79,2,1,12,0)=" ; Check the above variables to insure they consist of the proper"
^MAGD(2006.79,2,1,13,0)=" ; sequence of characters."
^MAGD(2006.79,2,1,14,0)=" Q:RADTE'?7N1"".""1.4N  ; Fileman internal date/time without seconds"
^MAGD(2006.79,2,1,15,0)=" K RASULT D DT^DILF(""T"",RADTE,.RASULT)"
^MAGD(2006.79,2,1,16,0)=" I RASULT=-1 K RASULT Q  ; invalid FM internal date format"
^MAGD(2006.79,2,1,17,0)=" K RASULT"
^MAGD(2006.79,2,1,18,0)=" Q:RADTI'?7N1"".""1.4N  ; reverse chronological date/time without seconds"
^MAGD(2006.79,2,1,19,0)=" Q:+RADFN'=RADFN  Q:'$D(^RADPT(RADFN,0))  ; not a number, or invalid ien"
^MAGD(2006.79,2,1,20,0)=" Q:RACN'?1.5N  ; case #'s lie in the range of 1-99999"
^MAGD(2006.79,2,1,21,0)=" Q:RACNI'?1N.N  ; must be a number, period"
^MAGD(2006.79,2,1,22,0)=" Q:'$D(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))  ; exam record missing"
^MAGD(2006.79,2,1,23,0)=" Q:$P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),U)'=RACN  ; case/exam mismatch"
^MAGD(2006.79,2,1,24,0)=" ; --------------------------------------------------------------------"
^MAGD(2006.79,2,1,25,0)=" ; continue whether exam was purged or not -- 08/23/00"
^MAGD(2006.79,2,1,26,0)=" N RAPRTSET,RAMEMARR,RA1"
^MAGD(2006.79,2,1,27,0)=" D EN2^RAUTL20(.RAMEMARR) ; is this case part of a print set ?"
^MAGD(2006.79,2,1,28,0)=" ; don't need to lock exam date's node"
^MAGD(2006.79,2,1,29,0)=" N I,J,X S I=$P(^RARPT(0),""^"",3)"
^MAGD(2006.79,2,1,30,0)="LOCK S I=I+1 L +^RARPT(I):1"
^MAGD(2006.79,2,1,31,0)=" I $T,'$D(^RARPT(I)),'$D(^RARPT(""B"",I)) G NEWOK"
^MAGD(2006.79,2,1,32,0)=" L -^RARPT(I)"
^MAGD(2006.79,2,1,33,0)=" S X=$G(^RAPRT(I,0))"
^MAGD(2006.79,2,1,34,0)=" ;"
^MAGD(2006.79,2,1,35,0)=" ; if lock-failed node belongs to this case, set rarpt & quit"
^MAGD(2006.79,2,1,36,0)=" I $P(X,""^"",2)=RADFN,(9999999.9999-$P(X,""^"",3))=RADTI,$P($P(X,""^""),""-"",2)=RACNI S RARPT=I G OUT"
^MAGD(2006.79,2,1,37,0)=" ; if lock-failed node belongs to a printset with the same patient and "
^MAGD(2006.79,2,1,38,0)=" ; exam date/time as the current case, set rarpt & quit"
^MAGD(2006.79,2,1,39,0)=" I RAPRTSET,$P(X,""^"",2)=RADFN,(9999999.9999-$P(X,""^"",3))=RADTI S RARPT=I G OUT"
^MAGD(2006.79,2,1,40,0)=" ;"
^MAGD(2006.79,2,1,41,0)=" G LOCK ; lock-failed node belongs to another case, thus try again"
^MAGD(2006.79,2,1,42,0)="NEWOK S ^RARPT(I,0)=$E(RADTE,4,7)_$E(RADTE,2,3)_""-""_RACN,RARPT=I,^(0)=$P(^RARPT(0),""^"",1,2)_""^""_I_""^""_($P(^(0),""^"",4)+1) D NOW^%DTC S DT=X K %,%H,%I"
^MAGD(2006.79,2,1,43,0)=" ; don't define ""T"" node"
^MAGD(2006.79,2,1,44,0)=" S $P(^RARPT(I,0),""^"",2,6)=RADFN_""^""_(9999999.9999-RADTI)_""^""_RACN_""^^""_DT ; don't stuff REPORTED DATE"
^MAGD(2006.79,2,1,45,0)=" S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,""DT"",RADTI,0),""^"",3) S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:"""") S $P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),""^"",17)=RARPT"
^MAGD(2006.79,2,1,46,0)=" S MAGSCN=$G(^MAG(2006.1,""AXSCN""))"
^MAGD(2006.79,2,1,47,0)=" I ('MAGSCN)!(MAGSCN=""N"") S MAGSCN="""""
^MAGD(2006.79,2,1,48,0)=" E  S MAGSCN=""Images captured for this report."""
^MAGD(2006.79,2,1,49,0)=" I $L(MAGSCN) S ^RARPT(RARPT,""R"",0)=""^^1^1^""_DT,^RARPT(RARPT,""R"",1,0)=MAGSCN"
^MAGD(2006.79,2,1,50,0)=" ; The orig. clin hist is now referenced directly from file 70, so"
^MAGD(2006.79,2,1,51,0)=" ; comment out next 2 lines to stop copying orig. clin hist from file 70"
^MAGD(2006.79,2,1,52,0)=" ;I $O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""H"",0)) S I=0 F J=0:1 S I=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""H"",I)) Q:I'>0  I $D(^(I,0)) S ^RARPT(RARPT,""H"",(J+1),0)=^(0)"
^MAGD(2006.79,2,1,53,0)=" ;S:J ^RARPT(RARPT,""H"",0)=""^^""_J_""^""_J_""^""_DT"
^MAGD(2006.79,2,1,54,0)=" ;Update Activity Log with 'images collected' transaction"
^MAGD(2006.79,2,1,55,0)=" S DA=RARPT,DIE=""^RARPT("",DR=""100///""""NOW"""""",DR(2,74.01)=""2////""_$S($D(RAESIG):""V"",1:""C"")_"";3////""_DUZ D ^DIE K DA,DR,DE,DQ,DIE"
^MAGD(2006.79,2,1,56,0)=" S DA=RARPT,DIK=""^RARPT("",RAQUEUED=1 D IX1^DIK ;D:$D(RAMDV) UPSTAT^RAUTL0"
^MAGD(2006.79,2,1,57,0)=" N RARPTN S RARPTN=$P(^RARPT(RARPT,0),""^"")"
^MAGD(2006.79,2,1,58,0)=" ;"
^MAGD(2006.79,2,1,59,0)=" ; create a var RARIC to suppress display of info msg from ptr^rarte2"
^MAGD(2006.79,2,1,60,0)=" ; if another case of this printset got cancelled"
^MAGD(2006.79,2,1,61,0)=" I RAPRTSET N RARIC S RARIC=1 D PTR^RARTE2"
^MAGD(2006.79,2,1,62,0)=" ; don't have to check raxit, since we're quitting now"
^MAGD(2006.79,2,1,63,0)=" ;"
^MAGD(2006.79,2,1,64,0)=" K DA,DIK,J,RAQUEUED"
^MAGD(2006.79,2,1,65,0)="OUT L -^RARPT(RARPT)"
^MAGD(2006.79,2,1,66,0)=" Q"
^MAGD(2006.79,2,1,67,0)="PTR ; create pointer in file 74 for Imaging package"
^MAGD(2006.79,2,1,68,0)=" ; called from MAGKEXC, MAGKEXC1 & MAGRIC"
^MAGD(2006.79,2,1,69,0)=" ; input:   RARPT - IEN of Rad/NM Report file #74"
^MAGD(2006.79,2,1,70,0)=" ;          MAGGP - IEN of record in file 2005 pointed to by a report"
^MAGD(2006.79,2,1,71,0)=" ; returns: Y=0  - variable MAGGP does not exist"
^MAGD(2006.79,2,1,72,0)=" ;          Y=-1 - FileMan could not create an entry"
^MAGD(2006.79,2,1,73,0)=" ;          Y>0  - FileMan created an entry"
^MAGD(2006.79,2,1,74,0)=" ;"
^MAGD(2006.79,2,1,75,0)=" N DA,DIC"
^MAGD(2006.79,2,1,76,0)=" I '$D(MAGGP) S Y=0 Q"
^MAGD(2006.79,2,1,77,0)=" S DIC(""P"")=$P(^DD(74,2005,0),U,2)"
^MAGD(2006.79,2,1,78,0)=" S DA(1)=RARPT,DIC=""^RARPT(""_DA(1)_"",2005,"",DIC(0)=""LZ"",X=MAGGP"
^MAGD(2006.79,2,1,79,0)=" K DD,DO D FILE^DICN"
^MAGD(2006.79,2,1,80,0)=" Q"
^MAGD(2006.79,3,0)="RARTE2^3050311.125836"
^MAGD(2006.79,3,1,0)="^2006.791^126^126"
^MAGD(2006.79,3,1,1,0)="RARTE2 ;HISC/SWM-Edit/Delete a Report ;7/16/01  14:05"
^MAGD(2006.79,3,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**10,31**;Mar 16, 1998"
^MAGD(2006.79,3,1,3,0)=" ; known vars-->RADFN,RACNI,RADTI,RARPT,RARPTN"
^MAGD(2006.79,3,1,4,0)="PTR ; if current ^RADPT() rec is a PRINT SET,"
^MAGD(2006.79,3,1,5,0)=" ; then for other ^RADPT() recs of the same PRINT SET,"
^MAGD(2006.79,3,1,6,0)=" ; create its corresponding subrec in ^RARPT()"
^MAGD(2006.79,3,1,7,0)=" S RAXIT=0"
^MAGD(2006.79,3,1,8,0)=" I '$D(RADFN)!'$D(RACNI)!'$D(RADTI)!'$D(RARPT)!'$D(RARPTN) D  Q"
^MAGD(2006.79,3,1,9,0)=" . S RAXIT=1 Q:$G(RARIC)"
^MAGD(2006.79,3,1,10,0)=" . I '$D(RAQUIET) W !!,$C(7),""Missing data (routine RARTE2)"",! S RAOUT=$$EOS^RAUTL5() Q"
^MAGD(2006.79,3,1,11,0)=" . S RAERR=""Missing data needed by routine RARTE2"""
^MAGD(2006.79,3,1,12,0)=" . Q"
^MAGD(2006.79,3,1,13,0)=" N RA1,RA2,RA3,RAFDA,RAIEN,RAMSG ;RA3=exam status"
^MAGD(2006.79,3,1,14,0)=" S RA1=0"
^MAGD(2006.79,3,1,15,0)="PTR2 S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1)) Q:RA1=""""  S RA2=$O(^(RA1,0)),RA3=$P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),""^"",3) G:$P(^(0),""^"",25)'=2 PTR2 ;skip non-combined rpt"
^MAGD(2006.79,3,1,16,0)=" G:RA2=RACNI PTR2 ;skip already processed case"
^MAGD(2006.79,3,1,17,0)=" K RAFDA,RAIEN,RAMSG"
^MAGD(2006.79,3,1,18,0)="ASK G:$G(RARIC) UPD G:$D(RAQUIET) UPD ; don't ask, if from Img pkg or Kurzweil"
^MAGD(2006.79,3,1,19,0)=" I $P(^RA(72,+RA3,0),""^"",3)=0 D  G:%=2 PTR2 G:%'=1 ASK"
^MAGD(2006.79,3,1,20,0)=" . W !!,""Case "",RA1,"" of this print set has been cancelled."""
^MAGD(2006.79,3,1,21,0)=" . W !,""Do you want to include it in the report anyway"""
^MAGD(2006.79,3,1,22,0)=" . S %=2 D YN^DICN"
^MAGD(2006.79,3,1,23,0)=" . W:%>0 ""..."",$S(%=2:""Ex"",%=1:""In"",1:""""),""clude case "",RA1"
^MAGD(2006.79,3,1,24,0)=" . Q"
^MAGD(2006.79,3,1,25,0)=" ; update file #70, field REPORT TEXT"
^MAGD(2006.79,3,1,26,0)="UPD S $P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),U,17)=RARPT"
^MAGD(2006.79,3,1,27,0)=" D INSERT"
^MAGD(2006.79,3,1,28,0)=" Q:RAXIT  G PTR2"
^MAGD(2006.79,3,1,29,0)="INSERT ; add subrec to file #74's subfile #74.05"
^MAGD(2006.79,3,1,30,0)=" S RAFDA(74.05,""?+2,""_RARPT_"","",.01)=$P(RARPTN,""-"")_""-""_RA1"
^MAGD(2006.79,3,1,31,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"")"
^MAGD(2006.79,3,1,32,0)=" I $D(RAMSG) D  Q"
^MAGD(2006.79,3,1,33,0)=" . S RAXIT=1 Q:$G(RARIC)"
^MAGD(2006.79,3,1,34,0)=" . I '$D(RAQUIET) W !!,$C(7),""Error encountered while setting sub-records (routine RARTE2)"",! S RAOUT=$$EOS^RAUTL5() Q  ;error detected"
^MAGD(2006.79,3,1,35,0)=" . S RAERR=""Error encountered while setting sub-recs from RARTE2"""
^MAGD(2006.79,3,1,36,0)=" Q"
^MAGD(2006.79,3,1,37,0)="DEL17(RAIEN) ;del other print set members' pointer to #74"
^MAGD(2006.79,3,1,38,0)=" Q:'$D(RADFN)!('$D(RADTI))"
^MAGD(2006.79,3,1,39,0)=" N RA4,RA1 D EN3^RAUTL20(.RA4)"
^MAGD(2006.79,3,1,40,0)=" Q:'$O(RA4(0))"
^MAGD(2006.79,3,1,41,0)=" S RA1="""""
^MAGD(2006.79,3,1,42,0)="D18 S RA1=$O(RA4(RA1)) Q:RA1="""""
^MAGD(2006.79,3,1,43,0)=" ; kill xrefs, if any, for file #70's REPORT TEXT"
^MAGD(2006.79,3,1,44,0)=" S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
^MAGD(2006.79,3,1,45,0)=" ; if this exam's piece 17 doesn't match RAIEN, then don't remove pc17"
^MAGD(2006.79,3,1,46,0)=" I $P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,0)),""^"",17)'=RAIEN G D18"
^MAGD(2006.79,3,1,47,0)=" D ENKILL^RAXREF(70.03,17,RAIEN,.DA)"
^MAGD(2006.79,3,1,48,0)=" ; set REPORT TEXT to null"
^MAGD(2006.79,3,1,49,0)=" S:$D(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,0)) $P(^(0),""^"",17)="""""
^MAGD(2006.79,3,1,50,0)=" G D18"
^MAGD(2006.79,3,1,51,0)="COPY ;copy physicians and diagnoses"
^MAGD(2006.79,3,1,52,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAMEMARR))!('$D(RADRS))"
^MAGD(2006.79,3,1,53,0)=" W !!,""... now copying "",$S(RADRS=1:""Diagnostic Codes"",1:""Staff & Resident data""),"" to other cases in this print set ..."",!"
^MAGD(2006.79,3,1,54,0)=" N RA1,RA2,RA3"
^MAGD(2006.79,3,1,55,0)=" N RA1PR,RA1PS ;prim res/staff"
^MAGD(2006.79,3,1,56,0)=" N RA1SR,RA1SS ; sec res/staff arrays--(ien subfile #70.11)=ien file #200"
^MAGD(2006.79,3,1,57,0)=" N RA1PD,RA1SD ; prim diag, then sec diags array"
^MAGD(2006.79,3,1,58,0)=" N RAFDA,RAIEN,RAMSG"
^MAGD(2006.79,3,1,59,0)=" ;prim res, prim staff, prim diag"
^MAGD(2006.79,3,1,60,0)=" S RA1=^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0) S:RADRS=2 RA1PR=$P(RA1,""^"",12),RA1PS=$P(RA1,""^"",15) S:RADRS=1 RA1PD=$P(RA1,""^"",13)"
^MAGD(2006.79,3,1,61,0)=" ;sec residents"
^MAGD(2006.79,3,1,62,0)=" I RADRS=2,$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""SRR"",0)) S RA1=0 F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""SRR"",RA1)) Q:+RA1'=RA1  S RA1SR(RA1)=+^(RA1,0)"
^MAGD(2006.79,3,1,63,0)=" ;sec staff"
^MAGD(2006.79,3,1,64,0)=" I RADRS=2,$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""SSR"",0)) S RA1=0 F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""SSR"",RA1)) Q:+RA1'=RA1  S RA1SS(RA1)=+^(RA1,0)"
^MAGD(2006.79,3,1,65,0)=" ;sec diagnoses"
^MAGD(2006.79,3,1,66,0)=" I RADRS=1,$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""DX"",0)) S RA1=0 F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""DX"",RA1)) Q:+RA1'=RA1  S RA1SD(RA1)=+^(RA1,0)"
^MAGD(2006.79,3,1,67,0)=" ;loop thru other cases of this printset"
^MAGD(2006.79,3,1,68,0)=" S RA1=0"
^MAGD(2006.79,3,1,69,0)="COPYLOOP S RA1=$O(RAMEMARR(RA1)) G:RA1="""" COPYREF G:RA1=RACNI COPYLOOP ;skip what's done already"
^MAGD(2006.79,3,1,70,0)=" ;"
^MAGD(2006.79,3,1,71,0)=" ; copy primary staff and resident via Fileman"
^MAGD(2006.79,3,1,72,0)=" I RADRS=2 D"
^MAGD(2006.79,3,1,73,0)=" . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
^MAGD(2006.79,3,1,74,0)=" . S DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","""
^MAGD(2006.79,3,1,75,0)=" . S DR=""12////""_RA1PR_"";15////""_RA1PS"
^MAGD(2006.79,3,1,76,0)=" . D ^DIE K DA,DIE,DR ; no locking"
^MAGD(2006.79,3,1,77,0)=" . Q"
^MAGD(2006.79,3,1,78,0)=" ;"
^MAGD(2006.79,3,1,79,0)=" ; copy primary diagnostic code via Fileman"
^MAGD(2006.79,3,1,80,0)=" I RADRS=1 D"
^MAGD(2006.79,3,1,81,0)=" . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
^MAGD(2006.79,3,1,82,0)=" . S DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","""
^MAGD(2006.79,3,1,83,0)=" . S DR=""13////""_RA1PD"
^MAGD(2006.79,3,1,84,0)=" . D ^DIE K DA,DIE,DR ; no locking"
^MAGD(2006.79,3,1,85,0)=" . Q"
^MAGD(2006.79,3,1,86,0)=" ;"
^MAGD(2006.79,3,1,87,0)=" S RA2=RA1_"",""_RADTI_"",""_RADFN ;stem for dataserver call"
^MAGD(2006.79,3,1,88,0)=" S DA(3)=RADFN,DA(2)=RADTI,DA(1)=RA1 ;base vars for DIK call"
^MAGD(2006.79,3,1,89,0)=" I RADRS=2 S RA3=0 D KIL3 G:RAXIT Q ; sec res"
^MAGD(2006.79,3,1,90,0)=" I RADRS=2 S RA3=0 D KIL4 G:RAXIT Q ; sec staff"
^MAGD(2006.79,3,1,91,0)=" I RADRS=1 S RA3=0 D KIL5 G:RAXIT Q ; sec diag"
^MAGD(2006.79,3,1,92,0)=" G COPYLOOP"
^MAGD(2006.79,3,1,93,0)="KIL3 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""SRR"",RA3)) G:RA3="""" COPY3"
^MAGD(2006.79,3,1,94,0)=" S DA=RA3"
^MAGD(2006.79,3,1,95,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""SRR"""","""
^MAGD(2006.79,3,1,96,0)=" D ^DIK"
^MAGD(2006.79,3,1,97,0)=" G KIL3"
^MAGD(2006.79,3,1,98,0)="COPY3 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SR(RA3)) Q:'RA3  Q:RAXIT"
^MAGD(2006.79,3,1,99,0)="UP3 ;"
^MAGD(2006.79,3,1,100,0)=" S RAFDA(70.09,""?+2,""_RA2_"","",.01)=RA1SR(RA3)"
^MAGD(2006.79,3,1,101,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY3"
^MAGD(2006.79,3,1,102,0)=" S RAXIT=1 W !!,$C(7),""Error encountered while in adding rec "",RA3,"" to sub-file 70.09"" Q"
^MAGD(2006.79,3,1,103,0)="KIL4 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""SSR"",RA3)) G:RA3="""" COPY4"
^MAGD(2006.79,3,1,104,0)=" S DA=RA3"
^MAGD(2006.79,3,1,105,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""SSR"""","""
^MAGD(2006.79,3,1,106,0)=" D ^DIK"
^MAGD(2006.79,3,1,107,0)=" G KIL4"
^MAGD(2006.79,3,1,108,0)="COPY4 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SS(RA3)) Q:'RA3  Q:RAXIT"
^MAGD(2006.79,3,1,109,0)="UP4 ;"
^MAGD(2006.79,3,1,110,0)=" S RAFDA(70.11,""?+2,""_RA2_"","",.01)=RA1SS(RA3)"
^MAGD(2006.79,3,1,111,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY4"
^MAGD(2006.79,3,1,112,0)=" S RAXIT=1 W !!,$C(7),""Error encountered while in adding rec "",RA3,"" to sub-file 70.11"" Q"
^MAGD(2006.79,3,1,113,0)="KIL5 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""DX"",RA3)) G:RA3="""" COPY5"
^MAGD(2006.79,3,1,114,0)=" S DA=RA3"
^MAGD(2006.79,3,1,115,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""DX"""","""
^MAGD(2006.79,3,1,116,0)=" D ^DIK"
^MAGD(2006.79,3,1,117,0)=" G KIL5"
^MAGD(2006.79,3,1,118,0)="COPY5 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SD(RA3)) Q:'RA3  Q:RAXIT"
^MAGD(2006.79,3,1,119,0)="UP5 ;"
^MAGD(2006.79,3,1,120,0)=" S RAFDA(70.14,""?+2,""_RA2_"","",.01)=RA1SD(RA3)"
^MAGD(2006.79,3,1,121,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY5"
^MAGD(2006.79,3,1,122,0)=" S RAXIT=1 W !!,$C(7),""Error encountered while in adding rec "",RA3,"" to sub-file 70.14"" Q"
^MAGD(2006.79,3,1,123,0)="COPYREF ; clear out Fileman vars and quit"
^MAGD(2006.79,3,1,124,0)=" K DA,DIK"
^MAGD(2006.79,3,1,125,0)=" Q  ; don't need to re-xref again"
^MAGD(2006.79,3,1,126,0)="Q K DA Q"
^MAGD(2006.79,4,0)="RAUTL^3050311.125836"
^MAGD(2006.79,4,1,0)="^2006.791^101^101"
^MAGD(2006.79,4,1,1,0)="RAUTL ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;12/4/97  14:21"
^MAGD(2006.79,4,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998"
^MAGD(2006.79,4,1,3,0)=" ;"
^MAGD(2006.79,4,1,4,0)=" ;Date range selection.  Time is allowed if RASKTIME is defined"
^MAGD(2006.79,4,1,5,0)=" ;Past date assumed. BEGDATE and ENDDATE are output variables"
^MAGD(2006.79,4,1,6,0)="DATE S RAPOP=0 K BEGDATE,ENDDATE W !!,""**** Date Range Selection ****"""
^MAGD(2006.79,4,1,7,0)=" W ! S %DT=""APEX""_$S($D(RASKTIME):""T"",1:""""),%DT(""A"")=""   Beginning DATE : "",%DT(0)=$S($D(RADDT):""0000101"",1:""-NOW"") D ^%DT S:Y<0 RAPOP=1 Q:Y<0  S (%DT(0),BEGDATE)=Y"
^MAGD(2006.79,4,1,8,0)="END W ! S %DT=""APEX""_$S($D(RASKTIME):""T"",1:""""),%DT(""A"")=""   Ending    DATE : "" D ^%DT K %DT S:Y<0 RAPOP=1 Q:Y<0  S ENDDATE=Y"
^MAGD(2006.79,4,1,9,0)=" Q"
^MAGD(2006.79,4,1,10,0)="DATE1 S RAPOP=0 K BEGDATE,ENDDATE W !!,""**** Date Range Selection ****"""
^MAGD(2006.79,4,1,11,0)=" W ! S %DT=""AEX""_$S($D(RASKTIME):""T"",1:""""),%DT(""A"")=""   Beginning DATE : "",%DT(0)=$S($D(RADDT):""0000101"",1:""-NOW"") D ^%DT S:Y<0 RAPOP=1 Q:Y<0  S (%DT(0),BEGDATE)=Y"
^MAGD(2006.79,4,1,12,0)="END1 W ! S %DT=""AEX""_$S($D(RASKTIME):""T"",1:""""),%DT(""A"")=""   Ending    DATE : "" D ^%DT K %DT S:Y<0 RAPOP=1 Q:Y<0  S ENDDATE=Y"
^MAGD(2006.79,4,1,13,0)=" Q"
^MAGD(2006.79,4,1,14,0)=" ;"
^MAGD(2006.79,4,1,15,0)=" ;Generic device/queuing selector"
^MAGD(2006.79,4,1,16,0)=" ;RAPOP will be >0 if the job was queued, or if device selection failed"
^MAGD(2006.79,4,1,17,0)=" ; $D(RADUPSCN)&$D(RADFLTP) stems from the 'Duplicate Flash Card' option."
^MAGD(2006.79,4,1,18,0)="ZIS I '$D(ZTDESC) S ZTDESC=""Rad/Nuc Med ""_$S($D(ZTRTN):ZTRTN,1:""UNKNOWN OPTION"")"
^MAGD(2006.79,4,1,19,0)=" S RAMES=$S($D(RAMES):RAMES,1:""W !?5,*7,""""Request Queued."""""")"
^MAGD(2006.79,4,1,20,0)=" W ! I $D(RASELDEV) W RASELDEV,! K RASELDEV"
^MAGD(2006.79,4,1,21,0)=" S %ZIS=""QMP"" K:$G(IOP)=""Q"" %ZIS S:$D(RADUPSCN)&$D(RADFLTP) %ZIS(""B"")=RADFLTP D ^%ZIS S RAPOP=POP Q:RAPOP  I $D(RAZIS),$E(IOST)'=""P"" D ^%ZISC S IOP=""Q"" W *7,!?5,""You must select a printer for this output."",! G ZIS"
^MAGD(2006.79,4,1,22,0)=" G ZIS1:'$D(IO(""Q""))"
^MAGD(2006.79,4,1,23,0)=" K IO(""Q"") S ZTIO=$S($D(ION):ION,1:"""") I ZTIO]"""" S ZTIO=ZTIO_$S($D(IO(""DOC"")):"";""_IOST_"";""_IO(""DOC""),1:"";""_IOST_"";""_IOM_"";""_IOSL)"
^MAGD(2006.79,4,1,24,0)=" D ^%ZTLOAD"
^MAGD(2006.79,4,1,25,0)=" I +$G(ZTSK(""D""))>0 X:$D(ZTSK) RAMES W:$D(ZTSK) ""  Task #: ""_$G(ZTSK)"
^MAGD(2006.79,4,1,26,0)=" K RAMES,ZTDESC,ZTSK,ZTIO,ZTSAVE,ZTRTN,RASV,ZTDTH D HOME^%ZIS S RAPOP=1 Q"
^MAGD(2006.79,4,1,27,0)="ZIS1 K RAMES,RASELDEV,ZTDESC,ZTRTN,ZTSAVE Q"
^MAGD(2006.79,4,1,28,0)=" ;"
^MAGD(2006.79,4,1,29,0)="CLOSE I $D(ZTQUEUED) S ZTREQ=""@"" Q"
^MAGD(2006.79,4,1,30,0)=" D ^%ZISC Q"
^MAGD(2006.79,4,1,31,0)=" ;"
^MAGD(2006.79,4,1,32,0)="D S Y=$P(""JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"",""^"",$E(Y,4,5))_"" ""_$S(Y#100:$J(Y#100\1,2)_"","",1:"""")_(Y\10000+1700)_$S(Y#1:""  ""_$E(Y_0,9,10)_"":""_$E(Y_""000"",11,12),1:"""") Q"
^MAGD(2006.79,4,1,33,0)=" ;"
^MAGD(2006.79,4,1,34,0)=" ;called to do some user checks"
^MAGD(2006.79,4,1,35,0)=" ;if div param set to ask user instead of auto filing DUZ, prompt for"
^MAGD(2006.79,4,1,36,0)=" ;   access/verify code"
^MAGD(2006.79,4,1,37,0)=" ;if RAKEY is defined, check if user owns this key and set RAPOP=1"
^MAGD(2006.79,4,1,38,0)=" ;   if user doesn't own key"
^MAGD(2006.79,4,1,39,0)="USER S RADUZ=DUZ S:'$D(RAMDV) RAMDV="""" I '$P(RAMDV,""^"",6) S %=""A"",%DUZ=DUZ W ! D ^XUVERIFY G USERQ:%=-1 I %'=1 W *7,"" ??"" G USER"
^MAGD(2006.79,4,1,40,0)="USER1 Q:'$D(RAKEY)  Q:$D(^XUSEC(RAKEY,RADUZ))  W !!?3,*7,""Must be a user with the appropriate privileges to continue!"""
^MAGD(2006.79,4,1,41,0)="USERQ S RAPOP=1 Q"
^MAGD(2006.79,4,1,42,0)=" ;"
^MAGD(2006.79,4,1,43,0)="DEV ;EXECUTEABLE HELP FOR DEVICE FIELDS IN FILE 79.1 (IMAGING LOCATIONS)"
^MAGD(2006.79,4,1,44,0)=" D HOME^%ZIS W @IOF,!,""The following is a list of possible devices. You must choose"",!,""one of these by entering in the device's full name."",!!,""NOTE: This field is not a pointer field to file 3.5!"",!"
^MAGD(2006.79,4,1,45,0)=" W !?3,""Device Name:"",?25,""Device Location:"",!?3,""------------"",?25,""----------------"""
^MAGD(2006.79,4,1,46,0)=" F I=0:0 S I=$O(^%ZIS(1,I)) Q:I'>0  I $D(^(I,0)) W !?3,$P(^(0),""^""),?25,$S($D(^(1)):^(1),1:"""") I ($Y+4)>IOSL R !,""(Type """"^"""" to stop)"",X:DTIME Q:'$T!(X=""^"")  W @IOF"
^MAGD(2006.79,4,1,47,0)=" Q"
^MAGD(2006.79,4,1,48,0)=" ;"
^MAGD(2006.79,4,1,49,0)="VERIFY ;Ask Access Code"
^MAGD(2006.79,4,1,50,0)=" K RADUZ S %=""A"",%DUZ=DUZ W ! D ^XUVERIFY S RADUZ=DUZ Q:%=-1!(%=1)  W:%=2 *7,!,""Sorry, that's not your access code.  Try again."" W:%=0 !,""Enter your access code or an uparrow to exit."" G VERIFY"
^MAGD(2006.79,4,1,51,0)=" ;"
^MAGD(2006.79,4,1,52,0)="A ;Create signature block name using RASIG(""PER"") as input IEN of file 200"
^MAGD(2006.79,4,1,53,0)=" ;Write signature to node 20 of file 200"
^MAGD(2006.79,4,1,54,0)=" ;(Signature is name in Firstname Lastname format)"
^MAGD(2006.79,4,1,55,0)=" S %X=$P(^VA(200,RASIG(""PER""),0),""^""),%X=$P(%X,"","",2)_"" ""_$P(%X,"","")_$P(%X,"","",3),$P(^VA(200,RASIG(""PER""),20),""^"",2)=%X K %X Q"
^MAGD(2006.79,4,1,56,0)=" ;"
^MAGD(2006.79,4,1,57,0)="DUZ ;Lookup and set RASIG(""PER"")=New Person File IFN, set signature block"
^MAGD(2006.79,4,1,58,0)=" ;text in File 200 if necessary, set RASIG(""NAME"")=signature block text"
^MAGD(2006.79,4,1,59,0)=" S %=1 I $D(DUZ)#2,+DUZ>0,$D(^VA(200,DUZ,0)) S RASIG(""PER"")=DUZ"
^MAGD(2006.79,4,1,60,0)=" I '$D(RASIG(""PER"")) S %=0 W:'$D(%INT) !,*7,""YOU ARE NOT IN THE 'NEW PERSON' FILE. CONTACT YOUR IRM SERVICE"",! K %INT Q"
^MAGD(2006.79,4,1,61,0)=" I '$D(^VA(200,RASIG(""PER""),20)) D A K %INT Q"
^MAGD(2006.79,4,1,62,0)=" I $P(^VA(200,RASIG(""PER""),20),""^"",2)="""" S %X=$P(^VA(200,RASIG(""PER""),0),""^""),%X=$P(%X,"","",2)_"" ""_$P(%X,"","")_$P(%X,"","",3),$P(^(20),""^"",2)=%X K %X"
^MAGD(2006.79,4,1,63,0)=" S RASIG(""NAME"")=$P(^VA(200,RASIG(""PER""),20),""^"",2) K %INT Q"
^MAGD(2006.79,4,1,64,0)=" ;"
^MAGD(2006.79,4,1,65,0)="SSN(PID,BID,DOD) ;returns full Pt.ID (VA(""PID"")), BID=1 returns VA(""BID"")"
^MAGD(2006.79,4,1,66,0)=" ;DOD is defined to internal entry # of eligibility of desired Pt.ID"
^MAGD(2006.79,4,1,67,0)=" N DFN"
^MAGD(2006.79,4,1,68,0)=" I '$D(RADFN) Q ""Unknown"""
^MAGD(2006.79,4,1,69,0)=" S:'$D(BID) BID="""" S:$D(DOD) VAPTYP=DOD"
^MAGD(2006.79,4,1,70,0)=" S DFN=RADFN D PID^VADPT6 I VAERR K VAERR Q ""Unknown"""
^MAGD(2006.79,4,1,71,0)=" S RASSN=$S(BID:VA(""BID""),1:VA(""PID""))"
^MAGD(2006.79,4,1,72,0)=" K VA(""BID""),VA(""PID""),VAERR,VAPTYP"
^MAGD(2006.79,4,1,73,0)=" Q RASSN"
^MAGD(2006.79,4,1,74,0)="WARNPRC ; send warning if user changes procedure within exam edit"
^MAGD(2006.79,4,1,75,0)=" ; and the exam has either or both radiopharms and meds"
^MAGD(2006.79,4,1,76,0)=" ; RAY (sub-rec 70.03) comes from rtns RAEDCN or RAEDPT (exam edit)"
^MAGD(2006.79,4,1,77,0)=" ; RAPRIT (ien file 71) comes from rtn RASTED (status tracking)"
^MAGD(2006.79,4,1,78,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
^MAGD(2006.79,4,1,79,0)=" Q:$G(RAY)']""""&('$D(RAPRIT))"
^MAGD(2006.79,4,1,80,0)=" N RAMEDS,RADIO,RATAB,RATEXT"
^MAGD(2006.79,4,1,81,0)=" S RAMEDS=0,RADIO=0"
^MAGD(2006.79,4,1,82,0)=" I $G(RAY)]"""",$P(RAY,U,2)=RAPRI Q  ;no change in procedure"
^MAGD(2006.79,4,1,83,0)=" I $G(RAPRIT)]"""",RAPRIT=RAPRI Q  ;no change in procedure"
^MAGD(2006.79,4,1,84,0)=" S RADIO=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),U,28) ;ptr fle #70.2"
^MAGD(2006.79,4,1,85,0)=" S RADIO=+$O(^RADPTN(+RADIO,""NUC"",0))"
^MAGD(2006.79,4,1,86,0)=" S RAMEDS=+$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""RX"",0))"
^MAGD(2006.79,4,1,87,0)=" S RAWHICH=0 ;first assume neither radiopharm nor meds"
^MAGD(2006.79,4,1,88,0)=" I 'RAMEDS,RADIO S RAWHICH=1 ;radiopharm only"
^MAGD(2006.79,4,1,89,0)=" I RAMEDS,'RADIO S RAWHICH=2 ;meds only"
^MAGD(2006.79,4,1,90,0)=" I RAMEDS,RADIO S RAWHICH=3 ;both radiopharm and meds"
^MAGD(2006.79,4,1,91,0)=" G:'RAWHICH WARN0"
^MAGD(2006.79,4,1,92,0)=" W !!?2,""**"",?21,""Since you have changed the procedure,"",?76,""**"""
^MAGD(2006.79,4,1,93,0)=" S RATAB=$S(RAWHICH=1:26,RAWHICH=2:34,1:21)"
^MAGD(2006.79,4,1,94,0)=" W !?2,""**"",?RATAB,""the"",$S(RAWHICH#2:"" Radiopharmaceuticals"",1:""""),$S(RAWHICH=3:"" and"",1:""""),$S(RAWHICH>1:"" Meds"",1:""""),"" for"",?76,""**"""
^MAGD(2006.79,4,1,95,0)=" S RATEXT=$S($G(RAY)]"""":$P($G(^RAMIS(71,+$P(RAY,U,2),0)),U),1:$P($G(^RAMIS(71,+$G(RAPRIT),0)),U)),RATAB=80-$L(RATEXT)/2"
^MAGD(2006.79,4,1,96,0)=" W !?2,""**"",?RATAB,RATEXT,?76,""**"""
^MAGD(2006.79,4,1,97,0)=" W !?2,""**"",?30,""will now be deleted."",?76,""**"",!,*7"
^MAGD(2006.79,4,1,98,0)=" Q"
^MAGD(2006.79,4,1,99,0)="WARN0 W !!?2,""**"",?17,""You have changed the procedure, but there are"",?76,""**"""
^MAGD(2006.79,4,1,100,0)=" W !?2,""**"",?14,""no data for Radiopharmaceuticals and Meds to delete."",?76,""**"",*7,!"
^MAGD(2006.79,4,1,101,0)=" Q"
^MAGD(2006.79,5,0)="RAUTL1^3050311.125836"
^MAGD(2006.79,5,1,0)="^2006.791^151^151"
^MAGD(2006.79,5,1,1,0)="RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;10/22/97  13:54"
^MAGD(2006.79,5,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**5,9,18**;Mar 16, 1998"
^MAGD(2006.79,5,1,3,0)=" ;last midification by SS for P18 June 19,00"
^MAGD(2006.79,5,1,4,0)=" I ""IOSCR""'[X!(X="""") S X=""Unknown"" Q"
^MAGD(2006.79,5,1,5,0)=" G @($E(X))"
^MAGD(2006.79,5,1,6,0)=" ;Set X=Inpatient Location"
^MAGD(2006.79,5,1,7,0)="I S X=$S($D(^DIC(42,+$P(^RADPT(D0,""DT"",D1,""P"",D2,0),""^"",6),0)):$P(^(0),""^""),1:""Unknown"")"
^MAGD(2006.79,5,1,8,0)=" Q"
^MAGD(2006.79,5,1,9,0)=" ;"
^MAGD(2006.79,5,1,10,0)=" ;Set X=Outpatient Location"
^MAGD(2006.79,5,1,11,0)="O S X=$S($D(^SC(+$P(^RADPT(D0,""DT"",D1,""P"",D2,0),""^"",8),0)):$P(^(0),""^""),1:""Unknown"")"
^MAGD(2006.79,5,1,12,0)=" Q"
^MAGD(2006.79,5,1,13,0)=" ;"
^MAGD(2006.79,5,1,14,0)=" ;Set X=Contract/Sharing Agreement patient location"
^MAGD(2006.79,5,1,15,0)="S ;"
^MAGD(2006.79,5,1,16,0)="C S X=$S($D(^DIC(34,+$P(^RADPT(D0,""DT"",D1,""P"",D2,0),""^"",9),0)):$P(^(0),""^""),1:""Unknown"")"
^MAGD(2006.79,5,1,17,0)=" Q"
^MAGD(2006.79,5,1,18,0)=" ;"
^MAGD(2006.79,5,1,19,0)=" ;Set X=Research patient location"
^MAGD(2006.79,5,1,20,0)="R S X=$S($D(^RADPT(D0,""DT"",D1,""P"",D2,""R"")):$P(^(""R""),""^""),1:""Unknown"") Q"
^MAGD(2006.79,5,1,21,0)=" ;"
^MAGD(2006.79,5,1,22,0)=" ;Set X=time of day in external format (ex: 2:28 PM)"
^MAGD(2006.79,5,1,23,0)="NOW S %=$P($H,"","",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) D TIME"
^MAGD(2006.79,5,1,24,0)=" Q"
^MAGD(2006.79,5,1,25,0)=" ;Input X=FM date/time, Output X=time (external format)"
^MAGD(2006.79,5,1,26,0)="TIME S X=$E($P(X,""."",2)_""0000"",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_"":""_$E(X#100+100,2,3)_"" ""_$E(""AP"",%+1)_""M"" S:$P(X,"":"")=0 X=12_"":""_$P(X,"":"",2)"
^MAGD(2006.79,5,1,27,0)=" Q"
^MAGD(2006.79,5,1,28,0)=" ;"
^MAGD(2006.79,5,1,29,0)="ELAPSED ;Pass parameters X (from date) and X1 (to date)"
^MAGD(2006.79,5,1,30,0)=" ;Variable Y is returned as either an elapsed time in the form DD:HH:MM where DD=days, HH=hours, MM=minutes or as the string 'Neg. Time' indicating a negative elapsed time"
^MAGD(2006.79,5,1,31,0)=" ;Variable Y1 is returned as the # of minutes of elapsed time"
^MAGD(2006.79,5,1,32,0)=" I '$D(RAMTIME) S DIC=""^DD(""""FUNC"""","",DIC(0)=""FX"",RAX=X,X=""MINUTES"" D ^DIC K DIC S X=RAX S:$D(^DD(""FUNC"",+Y,1)) RAMTIME=^(1) I '$D(RAMTIME) W *7,!!,""Can't continue --- No 'MINUTES' function found in File Manager"" K Y,Y1 G Q"
^MAGD(2006.79,5,1,33,0)=" X RAMTIME S Y1=X I X<0 S Y=""Neg. Time"" G Q"
^MAGD(2006.79,5,1,34,0)="MINUTS S X(1)=X\1440,X=X-(1440*X(1)),X(2)=X\60,X(3)=X-(60*X(2)),Y=$E(100+X(1),2,3)_"":""_$E(100+X(2),2,3)_"":""_$E(100+X(3),2,3)"
^MAGD(2006.79,5,1,35,0)="Q K RAX,X Q"
^MAGD(2006.79,5,1,36,0)=" ;"
^MAGD(2006.79,5,1,37,0)="UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option"
^MAGD(2006.79,5,1,38,0)=" I $O(RACCESS(DUZ,""""))="""" D SETVARS^RAPSET1(0)"
^MAGD(2006.79,5,1,39,0)=" I $G(RAIMGTY)="""" D SETVARS^RAPSET1(1)"
^MAGD(2006.79,5,1,40,0)=" I $G(RAIMGTY)="""" K XQUIT Q  ; didn't sign-on to an imaging location"
^MAGD(2006.79,5,1,41,0)=" D ^RACNLU G UPQ:""^""[X"
^MAGD(2006.79,5,1,42,0)=" I $D(^RA(72,""AA"",RAIMGTY,9,+RAST)),'$D(^XUSEC(""RA MGR"",DUZ)) W !!?3,*7,""You do not have the appropriate access privileges to act on completed exams."" G UPDATE"
^MAGD(2006.79,5,1,43,0)=" I $D(^RA(72,""AA"",RAIMGTY,0,+RAST)) W !!?3,*7,""Exam has been 'cancelled' therefore the status cannot be changed."" G UPDATE"
^MAGD(2006.79,5,1,44,0)=" ;D UP1 I RAOR>0 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","",DR=""100///""""NOW"""""",DR(2,70.07)=""2///U;3////""_$S($G(RADUZ):RADUZ,1:DUZ) D ^DIE"
^MAGD(2006.79,5,1,45,0)=" D UP1 I RAOR>0 D"
^MAGD(2006.79,5,1,46,0)=" .L +^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
^MAGD(2006.79,5,1,47,0)=" .N RAIEN"
^MAGD(2006.79,5,1,48,0)=" .S RAIENS=""+1,""_RACNI_"",""_RADTI_"",""_RADFN_"","""
^MAGD(2006.79,5,1,49,0)=" .S RAFDA(70.07,RAIENS,.01)=""NOW"""
^MAGD(2006.79,5,1,50,0)=" .K RAERR D UPDATE^DIE(""E"",""RAFDA"",""RAIEN"",""RAERR"")"
^MAGD(2006.79,5,1,51,0)=" .K RAFDA,RAIENS"
^MAGD(2006.79,5,1,52,0)=" .I $D(RAERR) L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI) K RAIEN Q"
^MAGD(2006.79,5,1,53,0)=" .S RAIENS=RAIEN(1)_"",""_RACNI_"",""_RADTI_"",""_RADFN_"","""
^MAGD(2006.79,5,1,54,0)=" .S RAFDA(70.07,RAIENS,2)=""U"""
^MAGD(2006.79,5,1,55,0)=" .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)"
^MAGD(2006.79,5,1,56,0)=" .D FILE^DIE(,""RAFDA"")"
^MAGD(2006.79,5,1,57,0)=" .L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
^MAGD(2006.79,5,1,58,0)="UPQ K RAFDA,RAIENS"
^MAGD(2006.79,5,1,59,0)=" K %,D,DA,DE,DIC,DIE,DQ,DR,I,J,POP,RACS,RAEND,RAF5,RAFL,RAFST,RAI,RAIX,RAJ1,RAORDIFN,RAPRIT,RAHEAD,RASN,RAOR,RASTI,RASSN,RADATE,RAST,RACN,RACNI,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,X,Y,Z,^TMP($J,""RAEX""),C,DIPGM Q"
^MAGD(2006.79,5,1,60,0)=" ;"
^MAGD(2006.79,5,1,61,0)=" ;Exam status updating and accompanying updates to status log, oe/rr"
^MAGD(2006.79,5,1,62,0)="UP1 N RA8 S RA8=0 ;use this to flag when one alert has been sent"
^MAGD(2006.79,5,1,63,0)=" D CMPAFTR^RAO7XX(1) ;P18 if procedure changed in RAEDCN or RAEDPT sends XX message to CPRS if needed"
^MAGD(2006.79,5,1,64,0)=" ; RA EDITCN and RA EDITPT should process this case only"
^MAGD(2006.79,5,1,65,0)=" I $D(RAOPT(""EDITCN""))!($D(RAOPT(""EDITPT""))) D UP2,UPK Q"
^MAGD(2006.79,5,1,66,0)=" ; see if this case belongs to a printset"
^MAGD(2006.79,5,1,67,0)=" N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR"
^MAGD(2006.79,5,1,68,0)=" D EN2^RAUTL20(.RAMEMARR) ;043099 always recalculate RAPRTSET"
^MAGD(2006.79,5,1,69,0)=" ; if not print set, then just process this case only"
^MAGD(2006.79,5,1,70,0)=" I 'RAPRTSET D UP2,UPK Q"
^MAGD(2006.79,5,1,71,0)=" ;case belongs to print set, so process all members of same print set"
^MAGD(2006.79,5,1,72,0)=" N RACNISAV,RA7"
^MAGD(2006.79,5,1,73,0)=" S RACNISAV=RACNI,RA7=0"
^MAGD(2006.79,5,1,74,0)=" F  S RA7=$O(RAMEMARR(RA7)) Q:RA7=""""  S RACNI=RA7 D UP2"
^MAGD(2006.79,5,1,75,0)=" S RACNI=RACNISAV"
^MAGD(2006.79,5,1,76,0)=" G UPK"
^MAGD(2006.79,5,1,77,0)="UP2 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","""
^MAGD(2006.79,5,1,78,0)=" N RAAFTER,RABEFORE"
^MAGD(2006.79,5,1,79,0)=" D STUFF^RASTREQ1 I RAOR<0,$D(RASN) W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?5,""...exam status remains '"",RASN,""'."" K DIE,RACS,RAPRIT Q"
^MAGD(2006.79,5,1,80,0)=" W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?3,""...will now designate exam status as '"",RASN,""'... for case no. "",$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),U)"
^MAGD(2006.79,5,1,81,0)=" ; S DR=""3////""_RASTI_$S($P(RAMDV,""^"",10):"";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())"",1:"""")"
^MAGD(2006.79,5,1,82,0)=" ; user duz could be in RADUZ, if session is from the Voice recognition"
^MAGD(2006.79,5,1,83,0)=" ;S DR(2,70.05)=$S($P(RAMDV,""^"",11)&('$D(ZTQUEUED)):"".01;"",1:"""")_""2////""_RASTI_"";3////""_$S($G(RADUZ):RADUZ,1:DUZ)"
^MAGD(2006.79,5,1,84,0)=" ;D ^DIE"
^MAGD(2006.79,5,1,85,0)=" L +^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
^MAGD(2006.79,5,1,86,0)=" N RAIEN"
^MAGD(2006.79,5,1,87,0)=" S RAIENS=RACNI_"",""_RADTI_"",""_RADFN_"","""
^MAGD(2006.79,5,1,88,0)=" S RAFDA(70.03,RAIENS,3)=RASTI"
^MAGD(2006.79,5,1,89,0)=" K RAERR D FILE^DIE(,""RAFDA"",""RAERR"")"
^MAGD(2006.79,5,1,90,0)=" I $D(RAERR) L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI) G UP2K ;L - P18"
^MAGD(2006.79,5,1,91,0)=" I $P(RAMDV,""^"",10) D"
^MAGD(2006.79,5,1,92,0)=" .S RAIENS=""+1,""_RACNI_"",""_RADTI_"",""_RADFN_"","""
^MAGD(2006.79,5,1,93,0)=" .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT())"
^MAGD(2006.79,5,1,94,0)=" .D UPDATE^DIE(,""RAFDA"",""RAIEN"")"
^MAGD(2006.79,5,1,95,0)=" .K RAFDA,RAIENS"
^MAGD(2006.79,5,1,96,0)=" .Q:'$D(RAIEN(1))"
^MAGD(2006.79,5,1,97,0)=" .I $P(RAMDV,""^"",11),('$D(ZTQUEUED)) D"
^MAGD(2006.79,5,1,98,0)=" ..S DIE=DIE_RACNI_"",""""T"""","",DA=RAIEN(1)"
^MAGD(2006.79,5,1,99,0)=" ..S DR="".01"""
^MAGD(2006.79,5,1,100,0)=" ..D ^DIE"
^MAGD(2006.79,5,1,101,0)=" .S RAIENS=RAIEN(1)_"",""_RACNI_"",""_RADTI_"",""_RADFN_"","""
^MAGD(2006.79,5,1,102,0)=" .S RAFDA(70.05,RAIENS,2)=RASTI"
^MAGD(2006.79,5,1,103,0)=" .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)"
^MAGD(2006.79,5,1,104,0)=" .K RAERR2 D FILE^DIE(,""RAFDA"")"
^MAGD(2006.79,5,1,105,0)=" L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
^MAGD(2006.79,5,1,106,0)=" ;"
^MAGD(2006.79,5,1,107,0)="UP2K K DE,DQ,DIE,DR,RAFDA,RAIENS K:$D(RAERR) RACS,RAPRIT Q:$D(RAERR)  W:'$D(RAONLINE)&('$D(ZTQUEUED)) !?10,""...exam status "",$S($G(RABEFORE)>$G(RAAFTER):""backed down"",1:""successfully updated""),""."" D ^RAORDC"
^MAGD(2006.79,5,1,108,0)=" I RA8=0,$D(^RA(72,RASTI,""ALERT"")),$P(^(""ALERT""),""^"")=""y"" D:$$ORVR^RAORDU()=2.5 OERR D:$$ORVR^RAORDU()'<3 OERR3 S RA8=1"
^MAGD(2006.79,5,1,109,0)=" I $D(^RA(72,RASTI,0)),$P(^(0),""^"",3)>1,RACS'=""Y"",$S('$D(RAF5):1,$P(^DIC(42,+RAF5,0),U,3)=""D"":1,1:0) D EN^RAUTL0"
^MAGD(2006.79,5,1,110,0)=" I $P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),U,30)="""" D EXM^RAHLRPC"
^MAGD(2006.79,5,1,111,0)=" K RACS,RAORDIFN,RAPRIT,RAF5"
^MAGD(2006.79,5,1,112,0)=" Q"
^MAGD(2006.79,5,1,113,0)="UPK K ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5"
^MAGD(2006.79,5,1,114,0)=" Q"
^MAGD(2006.79,5,1,115,0)="OERR ;Send Alert to OERR after pt examined"
^MAGD(2006.79,5,1,116,0)=" S ORVP=RADFN_"";DPT("",ORBPMSG=""Rad Pt Examined - ""_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),""^""),1,24),1:""Unknown"") S:$D(^RAO(75.1,+RAORDIFN,0)) ORIFN=+$P(^(0),""^"",7) S ORNOTE(21)=$S($D(ORIFN):1,1:"""") D NOTE^ORX3"
^MAGD(2006.79,5,1,117,0)=" Q"
^MAGD(2006.79,5,1,118,0)="OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3"
^MAGD(2006.79,5,1,119,0)=" ; Called from UP1"
^MAGD(2006.79,5,1,120,0)=" ;"
^MAGD(2006.79,5,1,121,0)=" ; RADFN,RADTI,RACNI,RAPRIT must be defined"
^MAGD(2006.79,5,1,122,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAPRIT))"
^MAGD(2006.79,5,1,123,0)=" ;"
^MAGD(2006.79,5,1,124,0)=" N RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY"
^MAGD(2006.79,5,1,125,0)=" S RADPTNDE=$G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))"
^MAGD(2006.79,5,1,126,0)=" S RAOIFN=$P(RADPTNDE,U,11) Q:'RAOIFN  ;file 75.1 ien"
^MAGD(2006.79,5,1,127,0)=" S RAONODE=$G(^RAO(75.1,+RAOIFN,0))"
^MAGD(2006.79,5,1,128,0)=" S RAOSTS=$P(RAONODE,U,5) Q:RAOSTS'=6  ;active exams only"
^MAGD(2006.79,5,1,129,0)=" S RAOIFN=$P(RAONODE,U,7) ;file 100 ien"
^MAGD(2006.79,5,1,130,0)=" S RAREQPHY=+$P(RADPTNDE,U,14) ;ordering provider"
^MAGD(2006.79,5,1,131,0)=" S RAREQPHY(RAREQPHY)="""""
^MAGD(2006.79,5,1,132,0)=" S RAMSG=""Imaging Pt Examined - ""_$S($D(^RAMIS(71,RAPRIT,0)):$E($P(^(0),U),1,24),1:""Unknown""),RAMSG=$E(RAMSG,1,51)"
^MAGD(2006.79,5,1,133,0)=" S RAIENS=RADTI_""~""_RACNI"
^MAGD(2006.79,5,1,134,0)=" ;"
^MAGD(2006.79,5,1,135,0)=" ; oe parameters:"
^MAGD(2006.79,5,1,136,0)=" ;         ORN: notification id (#100.9 ien)"
^MAGD(2006.79,5,1,137,0)=" ;         |     ORBDFN: patient id (#2 ien)"
^MAGD(2006.79,5,1,138,0)=" ;         |     |     ORNUM: order number (#100 ien)"
^MAGD(2006.79,5,1,139,0)=" ;         |     |     |        ORBADUZ: recipient array"
^MAGD(2006.79,5,1,140,0)=" ;         |     |     |        |     ORBPMSG: message text"
^MAGD(2006.79,5,1,141,0)=" ;         |     |     |        |     |      ORBPDATA exam dt~case iens"
^MAGD(2006.79,5,1,142,0)=" ;         |     |     |        |     |      |"
^MAGD(2006.79,5,1,143,0)=" D EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS)"
^MAGD(2006.79,5,1,144,0)=" Q"
^MAGD(2006.79,5,1,145,0)=" ;"
^MAGD(2006.79,5,1,146,0)=" ;Called by many report programs. Sets RACRT() array containing all"
^MAGD(2006.79,5,1,147,0)=" ;exam statuses that are to be included on the report.  RACRT is set"
^MAGD(2006.79,5,1,148,0)=" ;to the piece of the Exam Status File #72 record that corresponds"
^MAGD(2006.79,5,1,149,0)=" ;to the report being generated."
^MAGD(2006.79,5,1,150,0)="CRIT F I=0:0 S I=$O(^RA(72,I)) Q:'I  I $D(^(I,.3)),$P(^(.3),""^"",RACRT)=""y"" S RACRT(I)="""""
^MAGD(2006.79,5,1,151,0)=" Q"
^MAGD(2006.79,6,0)="RAUTL2^3050311.125836"
^MAGD(2006.79,6,1,0)="^2006.791^142^142"
^MAGD(2006.79,6,1,1,0)="RAUTL2 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;11/10/97  11:18"
^MAGD(2006.79,6,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**10,26,45**;Mar 16, 1998"
^MAGD(2006.79,6,1,3,0)=" ;"
^MAGD(2006.79,6,1,4,0)=" ;Called from many points within Rad/Nuc Med package ;ch"
^MAGD(2006.79,6,1,5,0)=" ;INPUT VARIABLES:  Y=IEN of Rad Report file #74"
^MAGD(2006.79,6,1,6,0)=" ;  XRT0,XRT1 If set, will do some response time checks"
^MAGD(2006.79,6,1,7,0)=" ;OUTPUT VARIABLES:"
^MAGD(2006.79,6,1,8,0)=" ;  RADFN=Patient DFN, RADTE=Exam date/time (FM format), "
^MAGD(2006.79,6,1,9,0)=" ;  RACN=long case number, RADTI=reverse exam date/time,"
^MAGD(2006.79,6,1,10,0)=" ;  RACNI=short case number, RADATE=Exam date/time (external format)"
^MAGD(2006.79,6,1,11,0)=" ;  Y=If active case, zeroeth node of case record in file #70"
^MAGD(2006.79,6,1,12,0)="RASET D:$D(XRTL) T0^%ZOSV S Y=$S($D(^RARPT(+Y,0)):^(0),1:"""") Q:'Y  S RADFN=+$P(Y,""^"",2),RADTE=+$P(Y,""^"",3),RACN=+$P(Y,""^"",4),RADTI=9999999.9999-RADTE,RACNI=$O(^RADPT(""ADC"",$P(Y,""^""),RADFN,RADTI,0)) S Y=RADTE D D^RAUTL S RADATE=Y"
^MAGD(2006.79,6,1,13,0)=" S Y="""" I RACNI,$D(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)) S Y=^(0)"
^MAGD(2006.79,6,1,14,0)=" I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV"
^MAGD(2006.79,6,1,15,0)=" Q"
^MAGD(2006.79,6,1,16,0)=" ;"
^MAGD(2006.79,6,1,17,0)=" ;Called from 2 x-refs on file #74, Rpt Status fld 5 ;ch"
^MAGD(2006.79,6,1,18,0)=" ;Does sets and kills for  'ARES', and 'ASTF' xrefs"
^MAGD(2006.79,6,1,19,0)=" ; ** CAUTION ** 1st RARAD=12 or 15, 2nd RARAD=ien for file 200"
^MAGD(2006.79,6,1,20,0)="XREF Q:'$D(^RARPT(DA,0))  S RADFNZ=^(0),RADTIZ=9999999.9999-$P(RADFNZ,""^"",3),RACNIZ=$O(^RADPT(+$P(RADFNZ,""^"",2),""DT"",RADTIZ,""P"",""B"",+$P(RADFNZ,""^"",4),0)),RADFNZ=+$P(RADFNZ,""^"",2),RADA=DA G Q:'RACNIZ"
^MAGD(2006.79,6,1,21,0)=" S RARADOLD=RARAD ;save 1st value of rarad"
^MAGD(2006.79,6,1,22,0)=" G Q:'$D(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",RACNIZ,0)) S RARAD=+$P(^(0),""^"",RARAD) G Q:'RARAD"
^MAGD(2006.79,6,1,23,0)=" ; ** CAUTION ** next line is reached 2 ways : from line above,"
^MAGD(2006.79,6,1,24,0)=" ;    and also from file 70.03, fld 15's ""ASTF"" xref"
^MAGD(2006.79,6,1,25,0)=" ;    thus RARAD's 2nd meaning must be preserved for XREF1"
^MAGD(2006.79,6,1,26,0)="XREF1 S:$D(RASET) ^RARPT(RAXREF,RARAD,RADA)="""" K:$D(RAKILL) ^RARPT(RAXREF,RARAD,RADA) D XPRI^RAUTL20"
^MAGD(2006.79,6,1,27,0)="Q K RADA,RADFNZ,RADTIZ,RACNIZ,RARADOLD Q"
^MAGD(2006.79,6,1,28,0)=" ;"
^MAGD(2006.79,6,1,29,0)=" ;Checks for CONTRAST MEDIA given the necessary subscripts"
^MAGD(2006.79,6,1,30,0)=" ;to access a record in File #70."
^MAGD(2006.79,6,1,31,0)=" ;RADFN, RADTI, RACNI must be set."
^MAGD(2006.79,6,1,32,0)=" ;Output is Y=a string delimited by commas containing all"
^MAGD(2006.79,6,1,33,0)=" ;applicable items in externally formatted text (ex:  If exam was"
^MAGD(2006.79,6,1,34,0)=" ;done with contrast media Y=""CONTRAST MEDIA USED"""
^MAGD(2006.79,6,1,35,0)=" ;06/16/99 remove obsolete RAF2"
^MAGD(2006.79,6,1,36,0)=" ;         add CPT Modifiers string"
^MAGD(2006.79,6,1,37,0)=" ; output Y = procedure modifiers string"
^MAGD(2006.79,6,1,38,0)=" ;        Y(1)= CPT modifiers string, external"
^MAGD(2006.79,6,1,39,0)=" ;        Y(2)= CPT modifiers string, internal"
^MAGD(2006.79,6,1,40,0)="MODS ;get procedure modifiers"
^MAGD(2006.79,6,1,41,0)=" S (Y,Y(1),Y(2))="""" Q:'$D(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))  S X=^(0)"
^MAGD(2006.79,6,1,42,0)=" F I=0:0 S I=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""M"",I)) Q:I'>0  I $D(^RAMIS(71.2,+^(I,0),0)) S X1=$P(^(0),""^"") D MODS1"
^MAGD(2006.79,6,1,43,0)=" S:$P(X,""^"",10)[""Y"" X1=""CONTRAST MEDIA USED"""
^MAGD(2006.79,6,1,44,0)=" ;"
^MAGD(2006.79,6,1,45,0)="MODS0 ;falls through from MODS; get CPT modifiers"
^MAGD(2006.79,6,1,46,0)=" S:Y="""" Y=""None"""
^MAGD(2006.79,6,1,47,0)=" S X=^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),I=0"
^MAGD(2006.79,6,1,48,0)=" F  S I=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""CMOD"",I)) Q:I'>0  S X1=$$BASICMOD^RACPTMSC(+$G(^(I,0)),DT) I +X1>0 S Y(1)=Y(1)_$S(Y(1)="""":"""",1:"", "")_$P(X1,""^"",2),Y(2)=Y(2)_$S(Y(2)="""":"""",1:"", "")_$P(X1,""^"")"
^MAGD(2006.79,6,1,49,0)=" S:Y(1)="""" Y(1)=""None"""
^MAGD(2006.79,6,1,50,0)=" K I,X,X1 Q"
^MAGD(2006.79,6,1,51,0)=" ;"
^MAGD(2006.79,6,1,52,0)="MODS1 ;builds procedure modifier string (called from MODS above)"
^MAGD(2006.79,6,1,53,0)=" S Y=Y_$S(Y="""":"""",1:"", "")_X1 Q"
^MAGD(2006.79,6,1,54,0)=" ;"
^MAGD(2006.79,6,1,55,0)=" ;called to do some order checks - takes appropriate action if:"
^MAGD(2006.79,6,1,56,0)=" ;  procedure requested needs Rad/NM physician approval (File 71, fld 11)"
^MAGD(2006.79,6,1,57,0)=" ;  there are other outstanding orders for this procedure for this pt"
^MAGD(2006.79,6,1,58,0)=" ;  user is inactivated (file 200, ""I"" node)"
^MAGD(2006.79,6,1,59,0)="ORDPRC I $D(^RAMIS(71,+X,0)),$P(^(0),""^"",11)[""y"" D CHKUSR I 'RAMSG W !!,""Please contact appropriate Imaging Service to request this procedure!  "" K X,RAMSG Q"
^MAGD(2006.79,6,1,60,0)=" S RAS3=+$P(^RAO(75.1,DA,0),""^"")"
^MAGD(2006.79,6,1,61,0)="ORDPRC1 Q:'$D(^RAO(75.1,""AP"",RAS3,X))  S RAS4=X,RASCNT=0 K RAX"
^MAGD(2006.79,6,1,62,0)=" F RAS5=0:0 S RAS5=$O(^RAO(75.1,""AP"",RAS3,RAS4,RAS5)) Q:'RAS5  F RAS6=0:0 S RAS6=$O(^RAO(75.1,""AP"",RAS3,RAS4,RAS5,RAS6)) Q:'RAS6  I $D(^RAO(75.1,RAS6,0)) S RAT=+$P(^(0),""^"",5) I RAT>2 S RASCNT=RASCNT+1 D:$S('$D(RAQUIT):1,1:RASCNT>1) ORDMES"
^MAGD(2006.79,6,1,63,0)=" I $D(RAX),'$D(RAQUIT) D ORDMES1"
^MAGD(2006.79,6,1,64,0)=" K:$D(RAX) RAQUIT K RAMSG,RAS3,RAS4,RAS5,RAS6,RASCNT,RAT,RAX Q"
^MAGD(2006.79,6,1,65,0)=" ;"
^MAGD(2006.79,6,1,66,0)="CHKUSR ; Check if valid user"
^MAGD(2006.79,6,1,67,0)=" N RAINADT,RAC"
^MAGD(2006.79,6,1,68,0)=" S RAINADT=+$P($G(^VA(200,+$G(DUZ),""PS"")),""^"",4)"
^MAGD(2006.79,6,1,69,0)=" S RAC=$O(^VA(200,+$G(DUZ),""RAC"",0))"
^MAGD(2006.79,6,1,70,0)=" S RAMSG=$S('($D(DUZ)#2):0,'$D(^VA(200,DUZ,0)):0,'RAC:0,'RAINADT:1,'$D(DT):0,DT'>RAINADT:1,1:0)"
^MAGD(2006.79,6,1,71,0)=" Q"
^MAGD(2006.79,6,1,72,0)="ORDMES W:'$D(RAX) !!,*7,""The following requests are already on file for this procedure:"",!"
^MAGD(2006.79,6,1,73,0)=" W !?3,""A request dated "" S Y=9999999.9999-RAS5 D DT^DIO2 W "" is already "",$S(RAT=3:""on "",1:""""),$P($P(^DD(75.1,5,0),RAT_"":"",2),"";""),"" for this procedure."" S RAX=1 Q"
^MAGD(2006.79,6,1,74,0)="ORDMES1 W !!?3,""Is it ok to continue? No// "" R RAX:DTIME S:'$T!(RAX="""")!(RAX[""^"") RAX=""N"""
^MAGD(2006.79,6,1,75,0)=" I ""Nn""[$E(RAX) K X S RAPRI=0"
^MAGD(2006.79,6,1,76,0)=" I $D(X),""Yy""'[$E(RAX) W !!?3,""Enter 'YES' to request this procedure for this patient, or 'NO' not to."",! G ORDMES1"
^MAGD(2006.79,6,1,77,0)=" Q"
^MAGD(2006.79,6,1,78,0)=" ;"
^MAGD(2006.79,6,1,79,0)=" ;Called (from RAPSET) to determine if at least one division and at"
^MAGD(2006.79,6,1,80,0)=" ;least one location are set up.  Can't use pkg unless these are set up."
^MAGD(2006.79,6,1,81,0)="CHKSP S RADV=$S($O(^RA(79,0))>0:1,1:0),RALC=$S($D(^RA(79.1,+$O(^RA(79,""AL"",0)),0)):1,1:0)"
^MAGD(2006.79,6,1,82,0)=" Q"
^MAGD(2006.79,6,1,83,0)=" ;"
^MAGD(2006.79,6,1,84,0)="KILLVAR ;This call will clean up possible variables left after execution"
^MAGD(2006.79,6,1,85,0)=" ;of the Label print fields in file 78.7"
^MAGD(2006.79,6,1,86,0)=" K RAY0,RAY1,RAY2,RAY3,RAGE,RACSE,RANOW,RADOB,RAEXDT,RATRAN,RARPDT,RADIAG,RAMOD,RAINST,RAEXLST,RAVST,RALCSE,RANM,RAPAGE,RAPR,RAL,RARST,RAREA,RADOC,RARAD,RASSN"
^MAGD(2006.79,6,1,87,0)=" K RASTAFF,RASIGS,RATECH,RACTY,RASIGVES,RAVER,RASIGVS,RASIGVSB,RASIGR,RASERV,RASEX,RAS,RAII,RAFMT,RASV"
^MAGD(2006.79,6,1,88,0)=" Q"
^MAGD(2006.79,6,1,89,0)=" ;"
^MAGD(2006.79,6,1,90,0)="CONTRAST(RAZ71) ;Display the contrast media/medium associated with a Rad/Nuc"
^MAGD(2006.79,6,1,91,0)=" ;Med Procedure. Called from: PRC1^RAUTL8 & ALLERGY^RAORD1"
^MAGD(2006.79,6,1,92,0)=" ;input: RAZ71=ien of the non-parent procedure in file 71"
^MAGD(2006.79,6,1,93,0)=" ;"
^MAGD(2006.79,6,1,94,0)=" K RAZCM S RAZ71(0)=$G(^RAMIS(71,RAZ71,0))"
^MAGD(2006.79,6,1,95,0)=" S RAZCMU=$P(RAZ71(0),""^"",20) ;is contrast media used?"
^MAGD(2006.79,6,1,96,0)=" I RAZCMU'=""Y"" K RAZCMU Q"
^MAGD(2006.79,6,1,97,0)=" D GETS^DIQ(71,RAZ71_"","",""125*"",""E"",""RAZCM"")"
^MAGD(2006.79,6,1,98,0)=" ; The RAZCM(71.0125,x,.01,""E"") array will be one or more of following"
^MAGD(2006.79,6,1,99,0)=" ; values: I:Iodinated contrast, ionic;N:Iodinated contrast, non-ionic"
^MAGD(2006.79,6,1,100,0)=" ;         L:Gadolinium, C:Cholecystogram;G:Gastrografin;B:Barium"
^MAGD(2006.79,6,1,101,0)=" ;"
^MAGD(2006.79,6,1,102,0)=" S:$O(RAZCM(71.0125,$C(126)),-1)=$O(RAZCM(71.0125,"""")) RAZTAG=""medium"""
^MAGD(2006.79,6,1,103,0)=" S:'$D(RAZTAG)#2 RAZTAG=""media"""
^MAGD(2006.79,6,1,104,0)=" S RAPMSG(1)=""**************   Patient reaction to contrast ""_RAZTAG_""   *************"""
^MAGD(2006.79,6,1,105,0)=" S RAPMSG(2)=$E($P(RAZ71(0),""^""),1,47)_"" uses contrast ""_RAZTAG_"": """
^MAGD(2006.79,6,1,106,0)=" S RAPMSG(2,""F"")=""!"",RAZI="""",RAZSUB=$O(RAPMSG($C(32)),-1)"
^MAGD(2006.79,6,1,107,0)=" F  S RAZI=$O(RAZCM(71.0125,RAZI)) Q:RAZI=""""  D"
^MAGD(2006.79,6,1,108,0)=" .S:$L($G(RAPMSG(RAZSUB)))+$L(RAZCM(71.0125,RAZI,.01,""E""))>69 RAZSUB=RAZSUB+1"
^MAGD(2006.79,6,1,109,0)=" .S RAPMSG(RAZSUB)=$G(RAPMSG(RAZSUB))_RAZCM(71.0125,RAZI,.01,""E"")_"", """
^MAGD(2006.79,6,1,110,0)=" .Q"
^MAGD(2006.79,6,1,111,0)=" ; The reverse dollar order (R$O) is used to strip off the "", "" string"
^MAGD(2006.79,6,1,112,0)=" ; from the last printable subscript containing CM data. I also use the"
^MAGD(2006.79,6,1,113,0)=" ; R$O to set my last printable array element to '*'s to box off the"
^MAGD(2006.79,6,1,114,0)=" ; warning."
^MAGD(2006.79,6,1,115,0)=" S RAPMSG($O(RAPMSG($C(32)),-1))=$E(RAPMSG($O(RAPMSG($C(32)),-1)),1,$L(RAPMSG($O(RAPMSG($C(32)),-1)))-2) ;strips off the "", """
^MAGD(2006.79,6,1,116,0)=" S $P(RAPMSG($O(RAPMSG($C(32)),-1)+1),""*"",69)="""",RAPMSG(99)="" """
^MAGD(2006.79,6,1,117,0)=" D EN^DDIOL(.RAPMSG)"
^MAGD(2006.79,6,1,118,0)=" K RAPMSG,RAZCM,RAZCMU,RAZI,RAZTAG,RAZSUB"
^MAGD(2006.79,6,1,119,0)=" Q"
^MAGD(2006.79,6,1,120,0)=" ;"
^MAGD(2006.79,6,1,121,0)="DELCM(DA) ;Ask the user if he/she is sure that deletion of contrast media"
^MAGD(2006.79,6,1,122,0)=" ;is intended. If the user enter '^' exit editng the template"
^MAGD(2006.79,6,1,123,0)=" ; input: DA=the ien of the record in file 71"
^MAGD(2006.79,6,1,124,0)=" ;output: RAYN=response to 'Are you sure?'; either 'Y', 'N', or '^'  "
^MAGD(2006.79,6,1,125,0)=" ;Called from the RA PROCEDURE EDIT input template (RA*5*45)"
^MAGD(2006.79,6,1,126,0)=" N RAYN W !?3,""*** Deleting all contrast media data associated with this procedure. ***"""
^MAGD(2006.79,6,1,127,0)=" F  D  Q:$L($G(RAYN))"
^MAGD(2006.79,6,1,128,0)=" .R !!?3,""All contrast relationships with this procedure will be deleted."",!?3,""Are you sure you want to delete? N// "",RAYN:DTIME"
^MAGD(2006.79,6,1,129,0)=" .S:'$T!(RAYN[""^"") RAYN=""^"" Q:RAYN=""^"""
^MAGD(2006.79,6,1,130,0)=" .S:RAYN="""" RAYN=""N"" Q:RAYN=""N"""
^MAGD(2006.79,6,1,131,0)=" .S RAYN=$$UP^XLFSTR($E(RAYN)) Q:RAYN=""Y""!(RAYN=""N"")"
^MAGD(2006.79,6,1,132,0)=" .I RAYN[""?"" W !?3,""Enter 'Y'es to delete associated contrasts, or 'N'o to preserve associated"",!?3,""contrasts."" K RAYN Q"
^MAGD(2006.79,6,1,133,0)=" .K RAYN W !?3,""Please enter 'Y' for yes, or 'N' for no."""
^MAGD(2006.79,6,1,134,0)=" .Q"
^MAGD(2006.79,6,1,135,0)=" ;The user does not want to delete associated cm data or has '^' out of"
^MAGD(2006.79,6,1,136,0)=" ;the option. We must reset the CONTRAST MEDIA USED (#20) field back to"
^MAGD(2006.79,6,1,137,0)=" ;yes from no."
^MAGD(2006.79,6,1,138,0)=" I RAYN'=""Y"" D"
^MAGD(2006.79,6,1,139,0)=" .K RAFDA S RAFDA(71,DA_"","",20)=""Y"" D FILE^DIE("""",""RAFDA"")"
^MAGD(2006.79,6,1,140,0)=" .K RAFDA Q"
^MAGD(2006.79,6,1,141,0)=" Q RAYN"
^MAGD(2006.79,6,1,142,0)=" ;"
^MAGD(2006.79,7,0)="RAUTL20^3050311.125836"
^MAGD(2006.79,7,1,0)="^2006.791^128^128"
^MAGD(2006.79,7,1,1,0)="RAUTL20 ;HISC/SWM-Utility Routine ;6/16/97  14:27"
^MAGD(2006.79,7,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**5,34**;Mar 16, 1998"
^MAGD(2006.79,7,1,3,0)=" ;"
^MAGD(2006.79,7,1,4,0)="EN1 ; for displaying  +  and  .   during case lookup"
^MAGD(2006.79,7,1,5,0)=" S RAPRTSET=0"
^MAGD(2006.79,7,1,6,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
^MAGD(2006.79,7,1,7,0)=" Q:RADFN=""""!(RADTI="""")!(RACNI="""")"
^MAGD(2006.79,7,1,8,0)=" ; output : RAPRTSET=1 : case is part of a combined PRINTset, & flag it"
^MAGD(2006.79,7,1,9,0)=" ;          RAMEMLOW=1 : case is lowest ien of print set AND flag it"
^MAGD(2006.79,7,1,10,0)=" N RA1,RA2,RA3,RA4,RA5,RA6,RA7,RACN S RA1="""",RA3=""A"",RA5=0"
^MAGD(2006.79,7,1,11,0)=" S RACN=+$G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))"
^MAGD(2006.79,7,1,12,0)=" S RAMEMLOW=0"
^MAGD(2006.79,7,1,13,0)=" S RAPRTSET=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),""^"",25)=2"
^MAGD(2006.79,7,1,14,0)=" Q:'RAPRTSET"
^MAGD(2006.79,7,1,15,0)=" ; put  +  infront of lowest ien of case that has MEMBER OF SET = 2"
^MAGD(2006.79,7,1,16,0)=" F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1)) Q:RA1=""""  Q:$P($G(^(RA1,0)),U,25)=2  ; RA1 is at lowest ien with MEMBER OF SET = 2"
^MAGD(2006.79,7,1,17,0)=" S:RACNI=RA1 RAMEMLOW=1"
^MAGD(2006.79,7,1,18,0)=" S RA1="""" F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1)) Q:RA1=""""  D LOOP1"
^MAGD(2006.79,7,1,19,0)=" I RA5 S RAPRTSET=0,RAMEMLOW=0 ;don't display if ptrs to #74 differ within set"
^MAGD(2006.79,7,1,20,0)=" Q"
^MAGD(2006.79,7,1,21,0)="LOOP1 ; RA1=  : for-loop var"
^MAGD(2006.79,7,1,22,0)=" ; RA2=  : (1) ien for 70.03  (2) also, pointer value to file #74"
^MAGD(2006.79,7,1,23,0)=" ; RA3=  : holds earliest case with pointer value to file #74"
^MAGD(2006.79,7,1,24,0)=" ; RA4=  : (ienof #70.03)=case number^procedure pointers^ptr #74"
^MAGD(2006.79,7,1,25,0)=" ; RA5=0 : all cases in set point to same non-null rarpt() or all null"
^MAGD(2006.79,7,1,26,0)=" ;         regardless of cancelled status"
^MAGD(2006.79,7,1,27,0)=" ; RA5<>0: one or more cases in set point to different rarpt()"
^MAGD(2006.79,7,1,28,0)=" ; RA6=  : pointer to file #72 examination status"
^MAGD(2006.79,7,1,29,0)=" ; RA7=1 : denote call of LOOP1 came from EN2 and not from EN1"
^MAGD(2006.79,7,1,30,0)=" S RA2=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1,0))"
^MAGD(2006.79,7,1,31,0)=" ; skip rec if it's not part of combined report"
^MAGD(2006.79,7,1,32,0)=" Q:$P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),""^"",25)'=2"
^MAGD(2006.79,7,1,33,0)=" S:$G(RA7) RA4=RA2,RA4(RA4)=RA1"
^MAGD(2006.79,7,1,34,0)=" S RA2=$P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),""^"",17),RA6=$P(^(0),""^"",3) S:$G(RA7) RA4(RA4)=RA4(RA4)_""^""_$P(^(0),""^"",2)_""^""_$P(^(0),""^"",17)_""^""_$P(^(0),""^"",3)"
^MAGD(2006.79,7,1,35,0)=" ; skip if exm canc'd & exm's pc 17 is null"
^MAGD(2006.79,7,1,36,0)=" I $P($G(^RA(72,+RA6,0)),""^"",3)=0,RA2="""" Q"
^MAGD(2006.79,7,1,37,0)=" S:RA3=""A"" RA3=RA2"
^MAGD(2006.79,7,1,38,0)=" I RA5=0,RA2]"""" S RA5=RA2-RA3"
^MAGD(2006.79,7,1,39,0)=" Q"
^MAGD(2006.79,7,1,40,0)="EN2(RA4) ; display all print members' procs during report editing/printg"
^MAGD(2006.79,7,1,41,0)=" S RAPRTSET=0"
^MAGD(2006.79,7,1,42,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
^MAGD(2006.79,7,1,43,0)=" Q:RADFN=""""!(RADTI="""")!(RACNI="""")"
^MAGD(2006.79,7,1,44,0)=" ; output : RA4(IEN OF #70.03)=CASE NUMBER^IEN OF #71 (procedure)^ptr #74"
^MAGD(2006.79,7,1,45,0)=" ;                            ^exm stat"
^MAGD(2006.79,7,1,46,0)=" ;          RAPRTSET = 1 : case is part of a combined PRINTset"
^MAGD(2006.79,7,1,47,0)=" N RA1,RA2,RA3,RA5,RA6,RA7 S RA1="""",RA3=""A"",RA5=0,RA7=1"
^MAGD(2006.79,7,1,48,0)=" F  S RA1=$O(RA4(RA1)) Q:RA1=""""  K RA4(RA1) ;clean up array"
^MAGD(2006.79,7,1,49,0)=" S RAPRTSET=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),""^"",25)=2"
^MAGD(2006.79,7,1,50,0)=" Q:'RAPRTSET"
^MAGD(2006.79,7,1,51,0)=" F  S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1)) Q:RA1=""""  D LOOP1"
^MAGD(2006.79,7,1,52,0)=" I RA5 S RAPRTSET=0 ;don't display if ptrs to #74 differ within set"
^MAGD(2006.79,7,1,53,0)=" Q"
^MAGD(2006.79,7,1,54,0)="EN3(RA4) ; for print set, AFTER record is created in rarpt()"
^MAGD(2006.79,7,1,55,0)=" Q:'$D(RADFN)!('$D(RADTI))"
^MAGD(2006.79,7,1,56,0)=" Q:RADFN=""""!(RADTI="""")"
^MAGD(2006.79,7,1,57,0)=" ; output :RA4(IEN OF #70.03)=CASE NUMBER  (ONLY THOSE CASES FROM #74.05)"
^MAGD(2006.79,7,1,58,0)=" N RA1,RA2,RA3,RA5 S RA1="""",RA3=""A"""
^MAGD(2006.79,7,1,59,0)=" F  S RA1=$O(RA4(RA1)) Q:RA1=""""  K RA4(RA1) ;clean up array"
^MAGD(2006.79,7,1,60,0)=" S RA5=$S($G(RARPT):RARPT,$G(RAIEN):RAIEN,1:0) Q:RA5=0"
^MAGD(2006.79,7,1,61,0)=" F  S RA1=$O(^RARPT(RA5,1,""B"",RA1)) Q:RA1=""""  S RA2=$P(RA1,""-"",2),RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA2,0)),RA4(RA3)=RA2"
^MAGD(2006.79,7,1,62,0)=" Q"
^MAGD(2006.79,7,1,63,0)="XPRI ;loop thru sub-file #74.05 to set/kill prim. xref for other prt members"
^MAGD(2006.79,7,1,64,0)=" Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RARAD))!('$D(RAXREF))!('$D(DA))"
^MAGD(2006.79,7,1,65,0)=" Q:$O(^RARPT(DA,1,""B"",0))="""""
^MAGD(2006.79,7,1,66,0)=" N RA1,RA200 S RA1="""""
^MAGD(2006.79,7,1,67,0)="XPRI1 S RA1=$O(^RARPT(DA,1,""B"",RA1)) Q:RA1="""""
^MAGD(2006.79,7,1,68,0)=" S RACNIZ=$O(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",""B"",$P(RA1,""-"",2),0))"
^MAGD(2006.79,7,1,69,0)=" G:'$D(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",RACNIZ,0)) XPRI1 S RA200=+$P(^(0),""^"",RARADOLD) ; use raradold to get piece number in ""p"" node"
^MAGD(2006.79,7,1,70,0)=" G XPRI1:'RA200"
^MAGD(2006.79,7,1,71,0)=" S:$D(RASET) ^RARPT(RAXREF,RA200,DA)="""""
^MAGD(2006.79,7,1,72,0)=" K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)"
^MAGD(2006.79,7,1,73,0)=" G XPRI1"
^MAGD(2006.79,7,1,74,0)="XSEC ;loop thru sub-file #74.05 to set/kill sec. xref for other print members"
^MAGD(2006.79,7,1,75,0)=" Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RASECOND))!('$D(RAXREF))!('$D(DA))"
^MAGD(2006.79,7,1,76,0)=" Q:$O(^RARPT(DA,1,""B"",0))="""""
^MAGD(2006.79,7,1,77,0)=" N RA1,RA2,RA200 S RA1="""""
^MAGD(2006.79,7,1,78,0)="XSEC1 S RA1=$O(^RARPT(DA,1,""B"",RA1)) Q:RA1="""""
^MAGD(2006.79,7,1,79,0)=" S RACNIZ=$O(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",""B"",$P(RA1,""-"",2),0))"
^MAGD(2006.79,7,1,80,0)=" G:'$D(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",RACNIZ,0)) XSEC1 G:'$D(^(RASECOND,0)) XSEC1"
^MAGD(2006.79,7,1,81,0)=" S RA2=0"
^MAGD(2006.79,7,1,82,0)="XSEC2 S RA2=$O(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",RACNIZ,RASECOND,RA2)) G:'+RA2 XSEC1 S RA200=+$G(^(RA2,0))"
^MAGD(2006.79,7,1,83,0)=" G:'RA200 XSEC2"
^MAGD(2006.79,7,1,84,0)=" S:$D(RASET) ^RARPT(RAXREF,RA200,DA)="""""
^MAGD(2006.79,7,1,85,0)=" K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)"
^MAGD(2006.79,7,1,86,0)=" G XSEC2"
^MAGD(2006.79,7,1,87,0)="FLAGMEM() ;in distr list, print + if case is part of a print set"
^MAGD(2006.79,7,1,88,0)=" ; called from File #74's print templates"
^MAGD(2006.79,7,1,89,0)=" N RA1 S RA1="""""
^MAGD(2006.79,7,1,90,0)=" I '$D(D0) Q RA1"
^MAGD(2006.79,7,1,91,0)=" S RA1=$P($G(^RABTCH(74.4,D0,0)),U) I RA1="""" Q RA1"
^MAGD(2006.79,7,1,92,0)=" S RA1=$O(^RARPT(RA1,1,""B"",0)) S:RA1]"""" RA1=""+"""
^MAGD(2006.79,7,1,93,0)=" Q RA1"
^MAGD(2006.79,7,1,94,0)="DELPNT(RADFN,RADTI,RACNI) ; When an exam is cancelled & it is associated"
^MAGD(2006.79,7,1,95,0)=" ; with data in the Nuc Med Exam Data file (70.2) ask the user if this"
^MAGD(2006.79,7,1,96,0)=" ; pointer to 70.2 is to be deleted.  Also delete the flag which"
^MAGD(2006.79,7,1,97,0)=" ; indicates that the dosage ticket had printed for this exam."
^MAGD(2006.79,7,1,98,0)=" ; Called from CANCEL^RAEDCN"
^MAGD(2006.79,7,1,99,0)=" ; Input: RADFN - Internal Entry Number (IEN) of the Patient."
^MAGD(2006.79,7,1,100,0)=" ;        RADTI - Date/Time of the examination (inverse format)"
^MAGD(2006.79,7,1,101,0)=" ;        RACNI - IEN of the exam for this date/time"
^MAGD(2006.79,7,1,102,0)=" ;"
^MAGD(2006.79,7,1,103,0)=" ;- Delete entry in 'Dosage Ticket Printed?' field DD: 70.03, field: 29 -"
^MAGD(2006.79,7,1,104,0)=" N RAFDA S RAFDA(70.03,RACNI_"",""_RADTI_"",""_RADFN_"","",29)=""@"""
^MAGD(2006.79,7,1,105,0)=" D FILE^DIE("""",""RAFDA"")"
^MAGD(2006.79,7,1,106,0)=" ;----------------------------------------------------------------------"
^MAGD(2006.79,7,1,107,0)=" Q:'+$P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),""^"",28)  ;no NucMed Xam data"
^MAGD(2006.79,7,1,108,0)=" K RAFDA N RAYN"
^MAGD(2006.79,7,1,109,0)=" F  D  Q:RAYN]"""""
^MAGD(2006.79,7,1,110,0)=" . R !!?3,""Do you wish to delete the radiopharmaceutical data associated"",!?3,""with this exam? No//"",RAYN:DTIME"
^MAGD(2006.79,7,1,111,0)=" . I RAYN[""^""!('$T) S RAYN=""^"" Q  ;don't delete pntr if '^' or timeout"
^MAGD(2006.79,7,1,112,0)=" . S RAYN=$E(RAYN) S:RAYN="""" RAYN=""N"""
^MAGD(2006.79,7,1,113,0)=" . S RAYN=$$UP^XLFSTR(RAYN) Q:RAYN=""N""  ;exit, don't del 70.2 pnt"
^MAGD(2006.79,7,1,114,0)=" . I RAYN=""Y"" D  Q  ; delete the pointer to 70.2, then quit"
^MAGD(2006.79,7,1,115,0)=" .. N RAFDA S RAFDA(70.03,RACNI_"",""_RADTI_"",""_RADFN_"","",500)=""@"""
^MAGD(2006.79,7,1,116,0)=" .. D FILE^DIE("""",""RAFDA"")"
^MAGD(2006.79,7,1,117,0)=" .. ; NOTE: This silent FileMan call not only deletes the pointer to"
^MAGD(2006.79,7,1,118,0)=" .. ;       the entry in the Nuc Med Exam Data file (70.2), but the"
^MAGD(2006.79,7,1,119,0)=" .. ;       entry in 70.2 itself. This is because a M X-Ref exists on"
^MAGD(2006.79,7,1,120,0)=" .. ;       the field which points to file 70.2 that also deletes the"
^MAGD(2006.79,7,1,121,0)=" .. ;       entry in the Nuc Med Exam Data file.  Please refer to"
^MAGD(2006.79,7,1,122,0)=" .. ;       ^DD(70.03,500,.. for more information."
^MAGD(2006.79,7,1,123,0)=" .. Q"
^MAGD(2006.79,7,1,124,0)=" . W !!?3,""Enter 'Yes' to delete the radiopharmaceutical data associated with this exam."",!?3,""Enter 'No' to preserve the radiopharmaceutical data associated with this"",!?3,""exam.  """
^MAGD(2006.79,7,1,125,0)=" . W ""Enter '^' to exit without deleting the radiopharmaceutical data"",!?3,""associated with this exam."",$C(7)"
^MAGD(2006.79,7,1,126,0)=" . S RAYN="""""
^MAGD(2006.79,7,1,127,0)=" . Q"
^MAGD(2006.79,7,1,128,0)=" Q"
^MAGD(2006.79,8,0)="RAUTL3^3050311.125836"
^MAGD(2006.79,8,1,0)="^2006.791^61^61"
^MAGD(2006.79,8,1,1,0)="RAUTL3 ;HISC/CAH,FPT,GJC AISC/SAW-Utility for Callable Entry Points ;4/1/97  10:04"
^MAGD(2006.79,8,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998"
^MAGD(2006.79,8,1,3,0)="EN1 ;ENTRY POINT FOR AMIE CALL"
^MAGD(2006.79,8,1,4,0)=" ;Requires four input variables"
^MAGD(2006.79,8,1,5,0)=" ;    DFN = Patient internal entry number"
^MAGD(2006.79,8,1,6,0)=" ;  Date range for report in Fileman internal format"
^MAGD(2006.79,8,1,7,0)=" ;    RABDT = Beginning Date (time optional)"
^MAGD(2006.79,8,1,8,0)=" ;    RAEDT = Ending Date (time optional)"
^MAGD(2006.79,8,1,9,0)=" ;  Exam locations (from file 44, Hospital Location) that are to be"
^MAGD(2006.79,8,1,10,0)=" ;    included in the report"
^MAGD(2006.79,8,1,11,0)=" ;    RAHLOC = A string of internal entry numbers for locations"
^MAGD(2006.79,8,1,12,0)=" ;               Each location separated by ^ and RAHLOC must begin"
^MAGD(2006.79,8,1,13,0)=" ;               and end with an ^ (e.g., RAHLOC=^3^ or RAHLOC=^56^75^)"
^MAGD(2006.79,8,1,14,0)=" ;               These are REQUESTING locations, not imaging locations"
^MAGD(2006.79,8,1,15,0)=" ;"
^MAGD(2006.79,8,1,16,0)=" I '$D(DFN)!('$D(RAHLOC))!('$D(RABDT))!('$D(RAEDT)) W !!,""Required variables are not defined.  Unable to continue."",*7 Q"
^MAGD(2006.79,8,1,17,0)=" S RAMIE=1 F RAPTR=RABDT-.0000001:0 S RAPTR=$O(^RADPT(DFN,""DT"",""B"",RAPTR)) Q:RAPTR'>0!(RAPTR>RAEDT)  S RAPTR1=$O(^(RAPTR,0)) I RAPTR1 F RAPTR2=0:0 S RAPTR2=$O(^RADPT(DFN,""DT"",RAPTR1,""P"",RAPTR2)) Q:RAPTR2'>0  I $D(^(RAPTR2,0)) S RAEX=^(0) D CHK"
^MAGD(2006.79,8,1,18,0)=" K RACNI,RAEX,RAII,RAK,RAMDIV,RAMDV,RAMLC,RAMIE,RANUM,RAPT1,RAPTR,RAPTR1,RAPTR2,RASSN,RAST Q"
^MAGD(2006.79,8,1,19,0)="CHK I $P(RAEX,U,17),RAHLOC[(U_$P(RAEX,U,22)_U) S RAST=$S($D(^RARPT($P(RAEX,""^"",17),0)):^(0),1:"""") I ""VR""[$P(RAST,""^"",5) S RARPT=$P(RAEX,""^"",17),RAPT1=1 D ^RARTR F RAK=0:0 S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0  I $D(^(RAK,0)) K @$P(^(0),""^"",5)"
^MAGD(2006.79,8,1,20,0)=" Q"
^MAGD(2006.79,8,1,21,0)="SIGNON  ;Check the # of reports to either pre-verify of verify."
^MAGD(2006.79,8,1,22,0)=" Q:'$D(DUZ)#2  N RA74,X0,X1,Y1 S (X0,X1,Y1)=0"
^MAGD(2006.79,8,1,23,0)=" ; first, tabulate # (Y1) of reports to pre-verify (if any)"
^MAGD(2006.79,8,1,24,0)=" F  S X0=$O(^RARPT(""ARES"",DUZ,X0)) Q:X0'>0  D"
^MAGD(2006.79,8,1,25,0)=" . S RA74=$G(^RARPT(X0,0))"
^MAGD(2006.79,8,1,26,0)=" . Q:$$STUB^RAEDCN1(X0)  ; skip stub report 031501"
^MAGD(2006.79,8,1,27,0)=" . Q:$P(RA74,""^"",5)=""V""  ; skip if already verified"
^MAGD(2006.79,8,1,28,0)=" . S:$P(RA74,""^"",12)']"""" Y1=Y1+1"
^MAGD(2006.79,8,1,29,0)=" . Q"
^MAGD(2006.79,8,1,30,0)=" S:Y1 X0=""!*** You have ""_Y1_"" imaging report""_$S(Y1>1:""s"",1:"""")_"" to pre-verify. ***"""
^MAGD(2006.79,8,1,31,0)=" D:Y1 SET^XUS1A(X0)"
^MAGD(2006.79,8,1,32,0)=" ; next tabulate # (X1) of reports to verify (if any)"
^MAGD(2006.79,8,1,33,0)=" S X0=0 F  S X0=$O(^RARPT(""ASTF"",DUZ,X0)) Q:X0'>0  D"
^MAGD(2006.79,8,1,34,0)=" . S RA74=$G(^RARPT(X0,0))"
^MAGD(2006.79,8,1,35,0)=" . Q:$$STUB^RAEDCN1(X0)  ; skip stub report 031501"
^MAGD(2006.79,8,1,36,0)=" . Q:$P(RA74,""^"",5)=""V""  ; skip if already verified"
^MAGD(2006.79,8,1,37,0)=" . S X1=X1+1"
^MAGD(2006.79,8,1,38,0)=" Q:X1'>0"
^MAGD(2006.79,8,1,39,0)=" S X0=""!*** You have ""_X1_"" imaging report""_$S(X1>1:""s"",1:"""")_"" to verify. ***"""
^MAGD(2006.79,8,1,40,0)=" D SET^XUS1A(X0)"
^MAGD(2006.79,8,1,41,0)=" Q"
^MAGD(2006.79,8,1,42,0)="UPDT(RANODE) ; Delete blank lines for Rad/Nuc Med Word Processing fields."
^MAGD(2006.79,8,1,43,0)=" ; These 'blank' consist of nothing more than spaces."
^MAGD(2006.79,8,1,44,0)=" ; 'RANODE' is the data node to be examined: i.e, for Clinical History"
^MAGD(2006.79,8,1,45,0)=" ; in Rad/Nuc Med Orders (75.1) RANODE=""^RAO(75.1,""_DA_"",H,"""
^MAGD(2006.79,8,1,46,0)=" ; -or in Rad/Nuc Med Reports (74) RANODE=""^RARPT(DA_"",R,"""
^MAGD(2006.79,8,1,47,0)=" ; "
^MAGD(2006.79,8,1,48,0)=" N RA0,RACNT,RAI,RATCNT,RAXIT,RAY"
^MAGD(2006.79,8,1,49,0)=" S (RACNT,RATCNT,RAXIT)=0 S RAI=999999999"
^MAGD(2006.79,8,1,50,0)=" S RAY=$G(@(RANODE_""0)"")),RAY(4)=+$P(RAY,""^"",4) Q:'RAY(4)"
^MAGD(2006.79,8,1,51,0)=" F  S RAI=$O(@(RANODE_RAI_"")""),-1) Q:RAI'>0  D  Q:RAXIT"
^MAGD(2006.79,8,1,52,0)=" . S RA0=$G(@(RANODE_RAI_"",0)""))"
^MAGD(2006.79,8,1,53,0)=" . I RA0?1.999"" "" D"
^MAGD(2006.79,8,1,54,0)=" .. K @(RANODE_RAI_"",0)"") S RACNT=RACNT+1"
^MAGD(2006.79,8,1,55,0)=" . E  S RAXIT=1"
^MAGD(2006.79,8,1,56,0)=" . Q"
^MAGD(2006.79,8,1,57,0)=" I RACNT D"
^MAGD(2006.79,8,1,58,0)=" . S RATCNT=RAY(4)-RACNT"
^MAGD(2006.79,8,1,59,0)=" . S @(RANODE_""0)"")=""^^""_RATCNT_""^""_RATCNT_""^""_$S($D(DT)#2:DT,1:$$DT^XLFDT())"
^MAGD(2006.79,8,1,60,0)=" . Q"
^MAGD(2006.79,8,1,61,0)=" Q"
^MAGD(2006.79,9,0)="RAUTL5^3050311.125836"
^MAGD(2006.79,9,1,0)="^2006.791^135^135"
^MAGD(2006.79,9,1,1,0)="RAUTL5 ;HISC/CAH,FPT,GJC-Utility Routine ;3/12/98  13:27"
^MAGD(2006.79,9,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**8,26**;Mar 16, 1998"
^MAGD(2006.79,9,1,3,0)="CH ; Populate the 'CLINICAL HISTORY' field (400) in file 74 (^RADPT)"
^MAGD(2006.79,9,1,4,0)=" ; Called from 'CREATE1^RAORD1'."
^MAGD(2006.79,9,1,5,0)=" N WPFLG"
^MAGD(2006.79,9,1,6,0)="CH1 I $D(RAVSTFLG),$D(RAVLEDTI),$D(RAVLECNI),$D(^RADPT(RADFN,""DT"",RAVLEDTI,""P"",RAVLECNI,""H"")) S:$D(^(""H"",0)) ^TMP($J,""RAWP"",0)=^(0) F RAI=1:1 Q:'$D(^RADPT(RADFN,""DT"",RAVLEDTI,""P"",RAVLECNI,""H"",RAI,0))  S ^TMP($J,""RAWP"",RAI,0)=^(0)"
^MAGD(2006.79,9,1,7,0)=" I $L($G(^RA(79,+RADIV,""HIS""))) W !!?3,*7,^(""HIS""),! K DIR S DIR(0)=""E"" D ^DIR I $D(DTOUT)!($D(DUOUT)) S RAOUT=1 Q"
^MAGD(2006.79,9,1,8,0)=" S DIC=""^TMP(""_$J_"",""""RAWP"""","",DWPK=1,DIWESUB=""Clin Hist/Reason"" W !,""CLINICAL HISTORY FOR EXAM"""
^MAGD(2006.79,9,1,9,0)=" D EN^DIWE K DIWESUB I '$O(^TMP($J,""RAWP"",0)) W !!,*7,""A clinical history corresponding to this request is required."",! D  Q:$D(RAOUT)  G CH1"
^MAGD(2006.79,9,1,10,0)=" .S DIR(0)=""Y"",DIR(""A"")=""Do you want to exit processing request"",DIR(""B"")=""Yes"" D ^DIR K DIR S:Y!($D(DIRUT)) RAOUT=1"
^MAGD(2006.79,9,1,11,0)=" K DIC S DIC=""^TMP(""_$J_"",""""RAWP"""","",DWPK=1"
^MAGD(2006.79,9,1,12,0)=" S WPFLG=$$VALWP(""^TMP(""_$J_"",""""RAWP"""","")"
^MAGD(2006.79,9,1,13,0)=" I 'WPFLG D  Q:$D(RAOUT)  G CH"
^MAGD(2006.79,9,1,14,0)=" . W !!,$C(7),""A clinical history corresponding to this request is required."",!"
^MAGD(2006.79,9,1,15,0)=" . K DIR S DIR(0)=""Y"",DIR(""B"")=""Yes"""
^MAGD(2006.79,9,1,16,0)=" . S DIR(""A"")=""Do you want to exit processing this request"""
^MAGD(2006.79,9,1,17,0)=" . S DIR(""?"")=""Enter 'Y' for yes, 'N' for no."" D ^DIR K DIR"
^MAGD(2006.79,9,1,18,0)=" . S:+Y!($D(DIRUT)) RAOUT=1 K DIROUT,DIRUT,DTOUT,DUOUT"
^MAGD(2006.79,9,1,19,0)=" . Q"
^MAGD(2006.79,9,1,20,0)="WPLEN ;Is clin hist too long to go into a local array for OE/RR HL7 msg?"
^MAGD(2006.79,9,1,21,0)=" S (CNT,X)=0 F  S X=$O(^TMP($J,""RAWP"",X)) S CNT=CNT+1 Q:X'>0"
^MAGD(2006.79,9,1,22,0)=" I CNT>350 K CNT D  Q:$D(RAOUT)  G CH"
^MAGD(2006.79,9,1,23,0)=" . W !!,$C(7),""Clinical history cannot exceed 350 lines."""
^MAGD(2006.79,9,1,24,0)=" . K DIR S DIR(0)=""Y"",DIR(""B"")=""Yes"""
^MAGD(2006.79,9,1,25,0)=" . S DIR(""A"")=""Do you want to exit processing this request"""
^MAGD(2006.79,9,1,26,0)=" . S DIR(""?"")=""Enter 'Y' for yes, 'N' for no."" D ^DIR K DIR"
^MAGD(2006.79,9,1,27,0)=" . S:+Y!($D(DIRUT)) RAOUT=1 K DIROUT,DIRUT,DTOUT,DUOUT"
^MAGD(2006.79,9,1,28,0)=" . Q"
^MAGD(2006.79,9,1,29,0)=" K CNT Q"
^MAGD(2006.79,9,1,30,0)=" ;"
^MAGD(2006.79,9,1,31,0)="VALWP(RAROOT) ; Validate word processing field."
^MAGD(2006.79,9,1,32,0)=" ; Pass back '1' if data is valid, '0' if not valid."
^MAGD(2006.79,9,1,33,0)=" ; at least 2 alphanumeric char's required"
^MAGD(2006.79,9,1,34,0)=" Q:'$O(@(RAROOT_""0)"")) 0"
^MAGD(2006.79,9,1,35,0)=" N CHAR,CNT,WL,WPFLG,X,Y,Z"
^MAGD(2006.79,9,1,36,0)=" S (WPFLG,X)=0"
^MAGD(2006.79,9,1,37,0)=" F  S X=$O(@(RAROOT_X_"")"")) Q:X'>0  D  Q:WPFLG"
^MAGD(2006.79,9,1,38,0)=" . S (CNT,WL)=0"
^MAGD(2006.79,9,1,39,0)=" . S Y=$G(@(RAROOT_X_"",0)"")) Q:Y']"""""
^MAGD(2006.79,9,1,40,0)=" . S WL=$L(Y)"
^MAGD(2006.79,9,1,41,0)=" . F Z=1:1:WL D  Q:WPFLG"
^MAGD(2006.79,9,1,42,0)=" .. S CHAR=$E(Y,Z) S:CHAR?1AN CNT=CNT+1"
^MAGD(2006.79,9,1,43,0)=" .. S:CHAR'?1AN&(CNT>0) CNT=0 S:CNT=2 WPFLG=1"
^MAGD(2006.79,9,1,44,0)=" .. Q"
^MAGD(2006.79,9,1,45,0)=" . Q"
^MAGD(2006.79,9,1,46,0)=" Q WPFLG"
^MAGD(2006.79,9,1,47,0)="RDQ(D0) ; Used by input transform on ^DD(74.31,2"
^MAGD(2006.79,9,1,48,0)=" ; Checks for unprinted reports associated with REPORT"
^MAGD(2006.79,9,1,49,0)=" ; DISTRIBUTION QUEUE of internal entry number of D0."
^MAGD(2006.79,9,1,50,0)=" N %,%Y,FOUND,RA744"
^MAGD(2006.79,9,1,51,0)=" S (FOUND,RA744)=0"
^MAGD(2006.79,9,1,52,0)=" F  S RA744=$O(^RABTCH(74.4,""C"",D0,RA744)) Q:RA744'>0!FOUND  D"
^MAGD(2006.79,9,1,53,0)=" . S FOUND=($P($G(^RABTCH(74.4,RA744,0)),""^"",4)'>0)"
^MAGD(2006.79,9,1,54,0)=" . Q"
^MAGD(2006.79,9,1,55,0)=" Q:'FOUND"
^MAGD(2006.79,9,1,56,0)=" W !!,""*** UNPRINTED REPORTS IN THE QUEUE ! ***"""
^MAGD(2006.79,9,1,57,0)=" W !,""If this queue is inactivated before printing, these reports will be"",!,""removed from the queue."""
^MAGD(2006.79,9,1,58,0)=" F  D  Q:%"
^MAGD(2006.79,9,1,59,0)=" . W !!,""Are you sure you want to remove these reports"""
^MAGD(2006.79,9,1,60,0)=" . S %=2 D YN^DICN"
^MAGD(2006.79,9,1,61,0)=" . I '% W !!?5,""Please answer Y(es) or N(o)."""
^MAGD(2006.79,9,1,62,0)=" . Q"
^MAGD(2006.79,9,1,63,0)=" I %'=1 W !,""Inactivation date deleted"" K X"
^MAGD(2006.79,9,1,64,0)=" Q"
^MAGD(2006.79,9,1,65,0)="ATND(RADFN,DATE) ;Returns the external form of the ATTENDING PHYSICIAN"
^MAGD(2006.79,9,1,66,0)=" ;for patient RADFN (IEN file #2) on date DATE (FM format)"
^MAGD(2006.79,9,1,67,0)=" N DPT,VA200,VAIP,X"
^MAGD(2006.79,9,1,68,0)=" S DFN=RADFN,VAIP(""D"")=DATE,VA200=1"
^MAGD(2006.79,9,1,69,0)=" I DATE D IN5^VADPT"
^MAGD(2006.79,9,1,70,0)=" S X=$P($G(VAIP(18)),""^"",2),X=$S(X]"""":X,1:""UNKNOWN"")"
^MAGD(2006.79,9,1,71,0)=" Q X"
^MAGD(2006.79,9,1,72,0)="PRIM(RADFN,DATE) ;Returns the external form of the PRIMARY PHYSICIAN"
^MAGD(2006.79,9,1,73,0)=" ;for patient RADFN (IEN file #2) on date DATE (FM format)"
^MAGD(2006.79,9,1,74,0)=" N DPT,VA200,VAIP,X"
^MAGD(2006.79,9,1,75,0)=" S DFN=RADFN,VAIP(""D"")=DATE,VA200=1"
^MAGD(2006.79,9,1,76,0)=" I DATE D IN5^VADPT"
^MAGD(2006.79,9,1,77,0)=" I '+$G(VAIP(7)) D"
^MAGD(2006.79,9,1,78,0)=" . ; If the Primary Physician is not found (based on inpatient episode)"
^MAGD(2006.79,9,1,79,0)=" . ; find the current PC Practitioner (See patch SD*5.3*30)"
^MAGD(2006.79,9,1,80,0)=" . ; VAIP(7) is null at this point.  VAIP(7) will exit this DO block"
^MAGD(2006.79,9,1,81,0)=" . ; set to the Primary Care Practitioner or null."
^MAGD(2006.79,9,1,82,0)=" . N X S X=""SDUTL3"" X ^%ZOSF(""TEST"")"
^MAGD(2006.79,9,1,83,0)=" . S:$T VAIP(7)=$$OUTPTPR^SDUTL3(RADFN)"
^MAGD(2006.79,9,1,84,0)=" . Q"
^MAGD(2006.79,9,1,85,0)=" S X=$P($G(VAIP(7)),""^"",2),X=$S(X]"""":X,1:""UNKNOWN"")"
^MAGD(2006.79,9,1,86,0)=" Q X"
^MAGD(2006.79,9,1,87,0)="EOS() ; 'End Of Screen' prompt for terminals only, check user response."
^MAGD(2006.79,9,1,88,0)=" Q:$E(IOST,1,2)'=""C-"" 0"
^MAGD(2006.79,9,1,89,0)=" N RAY,X,X1,X2,X3,Y,Y0,Y1,Y2,Y3,Y4,Y5"
^MAGD(2006.79,9,1,90,0)=" ;Returns 1 if user enters anything other than a carriage return"
^MAGD(2006.79,9,1,91,0)=" K DIR S DIR(0)=""E"" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT"
^MAGD(2006.79,9,1,92,0)=" S RAY='+Y"
^MAGD(2006.79,9,1,93,0)=" Q RAY"
^MAGD(2006.79,9,1,94,0)="XTERNAL(Y,C) ; Change internal format to external format"
^MAGD(2006.79,9,1,95,0)=" ; 'Y' is the internal form of the data"
^MAGD(2006.79,9,1,96,0)=" ; 'C' defines the data type of the variable 'Y'"
^MAGD(2006.79,9,1,97,0)=" D:Y]"""" Y^DIQ"
^MAGD(2006.79,9,1,98,0)=" Q Y"
^MAGD(2006.79,9,1,99,0)="PROCMSG(RAPRI) ; Print the appropriate procedure messages.  Called from"
^MAGD(2006.79,9,1,100,0)=" ; DESDT^RAUTL12.  This code works under the assumption that the"
^MAGD(2006.79,9,1,101,0)=" ; user has entered through OE/RR."
^MAGD(2006.79,9,1,102,0)=" ;ATTENTION: this code must be parallet to code in EN2^RAPRI"
^MAGD(2006.79,9,1,103,0)=" Q:+$G(RASTOP)  ; Do not display if displayed in the past."
^MAGD(2006.79,9,1,104,0)=" I $O(^RAMIS(71,RAPRI,3,0)) D  S RASTOP=1"
^MAGD(2006.79,9,1,105,0)=" . N I,RAX,X S I=0"
^MAGD(2006.79,9,1,106,0)=" . W !!?5,""NOTE: The following special requirements apply to this """
^MAGD(2006.79,9,1,107,0)=" . W ""procedure:"",$C(7),!"
^MAGD(2006.79,9,1,108,0)=" . F  S I=+$O(^RAMIS(71,RAPRI,3,I)) Q:'I  D"
^MAGD(2006.79,9,1,109,0)=" .. S RAX=+$G(^RAMIS(71,RAPRI,3,I,0))"
^MAGD(2006.79,9,1,110,0)=" .. I $D(^RAMIS(71.4,+RAX,0)) D"
^MAGD(2006.79,9,1,111,0)=" ... I $Y>(IOSL-6) D READ^ORUTL W @IOF"
^MAGD(2006.79,9,1,112,0)=" ... S X=$G(^RAMIS(71.4,+RAX,0)) W !?3,X"
^MAGD(2006.79,9,1,113,0)=" ... Q"
^MAGD(2006.79,9,1,114,0)=" .. Q"
^MAGD(2006.79,9,1,115,0)=" . Q"
^MAGD(2006.79,9,1,116,0)=" I $O(^RAMIS(71,RAPRI,""EDU"",0)),($$UP^XLFSTR($P($G(^RAMIS(71,RAPRI,0)),""^"",17))=""Y"") D"
^MAGD(2006.79,9,1,117,0)=" . W:+$O(^RAMIS(71,+RAPRI,3,0))>0 !!"
^MAGD(2006.79,9,1,118,0)=" . N DIW,DIWF,DIWL,DIWR,RAX,X"
^MAGD(2006.79,9,1,119,0)=" . K ^UTILITY($J,""W"") S DIWF=""W"",DIWL=1,DIWR=75,RAX=0"
^MAGD(2006.79,9,1,120,0)=" . F  S RAX=$O(^RAMIS(71,RAPRI,""EDU"",RAX)) Q:RAX'>0  D"
^MAGD(2006.79,9,1,121,0)=" .. I $Y>(IOSL-4) D READ^ORUTL W @IOF"
^MAGD(2006.79,9,1,122,0)=" .. S X=$G(^RAMIS(71,RAPRI,""EDU"",RAX,0)) D ^DIWP"
^MAGD(2006.79,9,1,123,0)=" .. Q"
^MAGD(2006.79,9,1,124,0)=" . I $Y>(IOSL-4) D READ^ORUTL W @IOF"
^MAGD(2006.79,9,1,125,0)=" . D ^DIWW"
^MAGD(2006.79,9,1,126,0)=" . W !"
^MAGD(2006.79,9,1,127,0)=" . Q"
^MAGD(2006.79,9,1,128,0)=" Q"
^MAGD(2006.79,9,1,129,0)="MIDNGHT(X) ; Check if the date passed in is midnight.  If it is, add one"
^MAGD(2006.79,9,1,130,0)=" ; minute to the date/time.  Fixes infinite loop problem in FM when"
^MAGD(2006.79,9,1,131,0)=" ; midnight."
^MAGD(2006.79,9,1,132,0)=" ; Input: X-Current system date/time (derived from $$NOW^XLFDT)"
^MAGD(2006.79,9,1,133,0)=" S:X[""."" X=$E(X,1,($F(X,""."")+3)) ; chop off seconds IF there's decimal"
^MAGD(2006.79,9,1,134,0)=" S:+$P(X,""."",2)=24!(+$P(X,""."",2)=0) X=$$FMADD^XLFDT(X,0,0,1,0) ; add a minute to midnight"
^MAGD(2006.79,9,1,135,0)=" Q X"
^MAGD(2006.79,10,0)="RAXREF^3050311.125837"
^MAGD(2006.79,10,1,0)="^2006.791^27^27"
^MAGD(2006.79,10,1,1,0)="RAXREF ;HISC/DAD-EXECUTE SET AND KILL XREF'S ;8/22/96  15:02"
^MAGD(2006.79,10,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998"
^MAGD(2006.79,10,1,3,0)=" ; REQUIRED VARIABLES"
^MAGD(2006.79,10,1,4,0)=" ;  RADICT = DATA DICTIONARY NUMBER"
^MAGD(2006.79,10,1,5,0)=" ;  RAFLD  = FIELD NUMBER IN THE ABOVE DD"
^MAGD(2006.79,10,1,6,0)=" ;  RAX    = FIELD VALUE TO BE CROSS REFERENCED"
^MAGD(2006.79,10,1,7,0)=" ;  DA     = DA or DA array"
^MAGD(2006.79,10,1,8,0)="ENKILL(RADICT,RAFLD,RAX,DA) ;"
^MAGD(2006.79,10,1,9,0)=" ; *** Execute a field's cross reference kill logic"
^MAGD(2006.79,10,1,10,0)=" D CHECK I RAEXIT D EXIT Q"
^MAGD(2006.79,10,1,11,0)=" S RAXSAV=RAX"
^MAGD(2006.79,10,1,12,0)=" F RAXREF=0:0 S RAXREF=$O(^DD(RADICT,RAFLD,1,RAXREF)) Q:RAXREF'>0  S X=RAXSAV X:$D(^DD(RADICT,RAFLD,1,RAXREF,2))#2 ^(2)"
^MAGD(2006.79,10,1,13,0)=" D EXIT"
^MAGD(2006.79,10,1,14,0)=" Q"
^MAGD(2006.79,10,1,15,0)="ENSET(RADICT,RAFLD,RAX,DA) ;"
^MAGD(2006.79,10,1,16,0)=" ; *** Execute a field's cross reference set logic"
^MAGD(2006.79,10,1,17,0)=" D CHECK I RAEXIT D EXIT Q"
^MAGD(2006.79,10,1,18,0)=" S RAXSAV=RAX"
^MAGD(2006.79,10,1,19,0)=" F RAXREF=0:0 S RAXREF=$O(^DD(RADICT,RAFLD,1,RAXREF)) Q:RAXREF'>0  S X=RAXSAV X:$D(^DD(RADICT,RAFLD,1,RAXREF,1))#2 ^(1)"
^MAGD(2006.79,10,1,20,0)=" D EXIT"
^MAGD(2006.79,10,1,21,0)=" Q"
^MAGD(2006.79,10,1,22,0)="EXIT ; Kill and quit"
^MAGD(2006.79,10,1,23,0)=" K RAEXIT,RAXREF,RAXSAV"
^MAGD(2006.79,10,1,24,0)=" Q"
^MAGD(2006.79,10,1,25,0)="CHECK ; Check if parameters are valid"
^MAGD(2006.79,10,1,26,0)=" S RAEXIT=$S($D(DA)[0:1,$D(RAX)[0:1,$D(RADICT)[0:1,$D(RAFLD)[0:1,RAX="""":1,RADICT'>0:1,RAFLD'>0:1,1:0)"
^MAGD(2006.79,10,1,27,0)=" Q"
^MAGD(2006.79,11,0)="TIULC1^3050311.125837"
^MAGD(2006.79,11,1,0)="^2006.791^217^217"
^MAGD(2006.79,11,1,1,0)="TIULC1 ; SLC/JER - More computational functions ;11/01/03"
^MAGD(2006.79,11,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**3,4,40,49,100,131,113,112**;Jun 20, 1997"
^MAGD(2006.79,11,1,3,0)=" ; External References"
^MAGD(2006.79,11,1,4,0)=" ; DBIA 2324  $$ISA^USRLM"
^MAGD(2006.79,11,1,5,0)=" ; Any patch which makes ANY changes to this rtn must include a"
^MAGD(2006.79,11,1,6,0)=" ;note in the patch desc reminding sites to update the Imaging"
^MAGD(2006.79,11,1,7,0)=" ;Gateway.  See IA # 3622."
^MAGD(2006.79,11,1,8,0)=" ; IN ADDITION, if changes are made to components used by Imaging, "
^MAGD(2006.79,11,1,9,0)=" ;namely PNAME, backward compatibility may not be enough. If"
^MAGD(2006.79,11,1,10,0)=" ;changes call additional rtns, TIU should consult with Imaging"
^MAGD(2006.79,11,1,11,0)=" ;on need to add additional rtns to list of TIU rtns copied for"
^MAGD(2006.79,11,1,12,0)=" ;Imaging Gateway."
^MAGD(2006.79,11,1,13,0)=" ;                         ****"
^MAGD(2006.79,11,1,14,0)=" ;"
^MAGD(2006.79,11,1,15,0)="ENCRYPT(X,X1,X2) ; Encrypt Text Strings"
^MAGD(2006.79,11,1,16,0)=" D EN^XUSHSHP"
^MAGD(2006.79,11,1,17,0)=" Q X"
^MAGD(2006.79,11,1,18,0)="DECRYPT(X,X1,X2) ; Decrypt Text Strings"
^MAGD(2006.79,11,1,19,0)=" D DE^XUSHSHP"
^MAGD(2006.79,11,1,20,0)=" Q X"
^MAGD(2006.79,11,1,21,0)="WHOSIGNS(DA) ; Evaluate who should be the expected signer"
^MAGD(2006.79,11,1,22,0)=" N Y,TIU12"
^MAGD(2006.79,11,1,23,0)=" S TIU12=$G(^TIU(8925,+DA,12))"
^MAGD(2006.79,11,1,24,0)=" I $P(TIU12,U,2)'=$P(TIU12,U,9) S Y=$P(TIU12,U,2)"
^MAGD(2006.79,11,1,25,0)=" E  S Y=$P(TIU12,U,9)"
^MAGD(2006.79,11,1,26,0)=" Q Y"
^MAGD(2006.79,11,1,27,0)="WHOCOSIG(DA) ; Evaluate who should be the expected cosigner"
^MAGD(2006.79,11,1,28,0)=" N Y,TIU12"
^MAGD(2006.79,11,1,29,0)=" S TIU12=$G(^TIU(8925,+DA,12))"
^MAGD(2006.79,11,1,30,0)=" I $P(TIU12,U,2)=$P(TIU12,U,9) D"
^MAGD(2006.79,11,1,31,0)=" . I $P(TIU12,U,8)]"""" S Y=""@"""
^MAGD(2006.79,11,1,32,0)=" . E  S Y="""""
^MAGD(2006.79,11,1,33,0)=" E  S Y=$P(TIU12,U,9)"
^MAGD(2006.79,11,1,34,0)=" Q Y"
^MAGD(2006.79,11,1,35,0)=" ;"
^MAGD(2006.79,11,1,36,0)="HASADDEN(DA,IDKIDFLG) ; Evaluate whether a given record has addenda"
^MAGD(2006.79,11,1,37,0)=" ; **100**:"
^MAGD(2006.79,11,1,38,0)=" ; If +IDKIDFLG, check interdisciplinary kids of DA, as well as DA."
^MAGD(2006.79,11,1,39,0)=" N TIUI,TIUY,TIUJ,TIUK"
^MAGD(2006.79,11,1,40,0)=" S (TIUI,TIUJ,TIUY)=0"
^MAGD(2006.79,11,1,41,0)=" F  S TIUI=$O(^TIU(8925,""DAD"",+DA,TIUI)) Q:+TIUI'>0  D  Q:TIUY"
^MAGD(2006.79,11,1,42,0)=" . I $P($G(^TIU(8925.1,+$G(^TIU(8925,+TIUI,0)),0)),U)[""ADDENDUM"" S TIUY=1"
^MAGD(2006.79,11,1,43,0)=" I TIUY!'$G(IDKIDFLG) G HASX"
^MAGD(2006.79,11,1,44,0)=" ;**100** Check ID kids for addenda:"
^MAGD(2006.79,11,1,45,0)=" F  S TIUJ=$O(^TIU(8925,""GDAD"",+DA,TIUJ)) Q:+TIUJ'>0  D  Q:TIUY"
^MAGD(2006.79,11,1,46,0)=" . S TIUK=0"
^MAGD(2006.79,11,1,47,0)=" . F  S TIUK=$O(^TIU(8925,""DAD"",TIUJ,TIUK)) Q:+TIUK'>0  D  Q:TIUY"
^MAGD(2006.79,11,1,48,0)=" . . I $P($G(^TIU(8925.1,+$G(^TIU(8925,+TIUK,0)),0)),U)[""ADDENDUM"" S TIUY=1"
^MAGD(2006.79,11,1,49,0)="HASX Q TIUY"
^MAGD(2006.79,11,1,50,0)=" ;"
^MAGD(2006.79,11,1,51,0)="ISADDNDM(DA) ; Evaluate whether a given record IS an addendum"
^MAGD(2006.79,11,1,52,0)=" N TIUY S TIUY=0"
^MAGD(2006.79,11,1,53,0)=" I $P($G(^TIU(8925.1,+$G(^TIU(8925,+DA,0)),0)),U)[""ADDENDUM"",+$P($G(^TIU(8925,+DA,0)),U,6)>0 S TIUY=1"
^MAGD(2006.79,11,1,54,0)=" Q TIUY"
^MAGD(2006.79,11,1,55,0)="PNAME(DA) ; Receives pointer to 8925.1, returns display name of"
^MAGD(2006.79,11,1,56,0)=" ; document class"
^MAGD(2006.79,11,1,57,0)=" N TIUY,TIUMOM S TIUMOM=0"
^MAGD(2006.79,11,1,58,0)=" I +$G(DA)'>0 Q ""UNKNOWN"""
^MAGD(2006.79,11,1,59,0)=" S TIUMOM=$O(^TIU(8925.1,""AD"",DA,TIUMOM))"
^MAGD(2006.79,11,1,60,0)=" I $P($G(^TIU(8925.1,+DA,0)),U,4)=""CO"" S TIUMOM=0"
^MAGD(2006.79,11,1,61,0)=" I +$P($G(^TIU(8925.1,+DA,0)),U,9)=0 S TIUMOM=0"
^MAGD(2006.79,11,1,62,0)=" I +TIUMOM>0  D"
^MAGD(2006.79,11,1,63,0)=" . S TIUY=$P($G(^TIU(8925.1,+TIUMOM,0)),U,3)"
^MAGD(2006.79,11,1,64,0)=" . I TIUY']"""" S TIUY=$$MIXED^TIULS($P($G(^TIU(8925.1,+TIUMOM,0)),U))"
^MAGD(2006.79,11,1,65,0)=" I +TIUMOM'>0 D"
^MAGD(2006.79,11,1,66,0)=" . S TIUY=$P($G(^TIU(8925.1,+DA,0)),U,3)"
^MAGD(2006.79,11,1,67,0)=" . I TIUY']"""" S TIUY=$$MIXED^TIULS($P($G(^TIU(8925.1,+DA,0)),U))"
^MAGD(2006.79,11,1,68,0)=" Q TIUY"
^MAGD(2006.79,11,1,69,0)="ABBREV(DA) ; Get abbreviaton for a document type or class"
^MAGD(2006.79,11,1,70,0)=" Q $P($G(^TIU(8925.1,+DA,0)),U,2)"
^MAGD(2006.79,11,1,71,0)="PERSNAME(USER) ; Receives pointer to 200, returns name field"
^MAGD(2006.79,11,1,72,0)=" N X S X=$$GET1^DIQ(200,USER,.01)"
^MAGD(2006.79,11,1,73,0)=" Q $S($L(X):X,1:""UNKNOWN"")"
^MAGD(2006.79,11,1,74,0)="BEEP(USER) ; Get beeper #'s "
^MAGD(2006.79,11,1,75,0)=" Q $P($G(^VA(200,+USER,.13)),U,7,8)"
^MAGD(2006.79,11,1,76,0)="DOCPRM(TIUTYP,TIUDPRM,TIUDA) ; Get Document Parameters, support inheritance"
^MAGD(2006.79,11,1,77,0)=" N TIUI,TIUDAD"
^MAGD(2006.79,11,1,78,0)=" S (TIUDPRM(0),TIUDPRM(5))="""""
^MAGD(2006.79,11,1,79,0)=" I $P($G(^TIU(8925.1,+TIUTYP,0)),U)[""ADDENDUM"",+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))"
^MAGD(2006.79,11,1,80,0)=" S TIUI=+$O(^TIU(8925.95,""B"",+TIUTYP,0))"
^MAGD(2006.79,11,1,81,0)=" I +TIUI D  Q"
^MAGD(2006.79,11,1,82,0)=" . S TIUDPRM(0)=$G(^TIU(8925.95,+TIUI,0))"
^MAGD(2006.79,11,1,83,0)=" . I +$O(^TIU(8925.95,+TIUI,5,0)) D"
^MAGD(2006.79,11,1,84,0)=" . . N TIUJ S TIUJ=0"
^MAGD(2006.79,11,1,85,0)=" . . F  S TIUJ=$O(^TIU(8925.95,+TIUI,5,TIUJ)) Q:+TIUJ'>0  D"
^MAGD(2006.79,11,1,86,0)=" . . . S $P(TIUDPRM(5),U,TIUJ)=+$G(^TIU(8925.95,+TIUI,5,+TIUJ,0))"
^MAGD(2006.79,11,1,87,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,88,0)=" I +TIUDAD D DOCPRM(TIUDAD,.TIUDPRM)"
^MAGD(2006.79,11,1,89,0)=" Q"
^MAGD(2006.79,11,1,90,0)="POSTFILE(TIUTYP) ; Get Post-filing Code, support inheritance"
^MAGD(2006.79,11,1,91,0)=" N TIUPOST,TIUDAD"
^MAGD(2006.79,11,1,92,0)=" S TIUPOST=$G(^TIU(8925.1,+TIUTYP,4.5))"
^MAGD(2006.79,11,1,93,0)=" I TIUPOST]"""" G POSTFILX"
^MAGD(2006.79,11,1,94,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,95,0)=" I +TIUDAD S TIUPOST=$$POSTFILE(TIUDAD)"
^MAGD(2006.79,11,1,96,0)="POSTFILX Q TIUPOST"
^MAGD(2006.79,11,1,97,0)="FIXCODE(TIUTYP) ; Get Error Resolution Code, support inheritance"
^MAGD(2006.79,11,1,98,0)=" N TIUFIX,TIUDAD"
^MAGD(2006.79,11,1,99,0)=" S TIUFIX=$G(^TIU(8925.1,+TIUTYP,4.8))"
^MAGD(2006.79,11,1,100,0)=" I TIUFIX]"""" G FIXCODX"
^MAGD(2006.79,11,1,101,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,102,0)=" ; Don't inherit PN code for consults: TIU*1*131"
^MAGD(2006.79,11,1,103,0)=" I +TIUTYP=$$CLASS^TIUCNSLT,TIUDAD=3 G FIXCODX"
^MAGD(2006.79,11,1,104,0)=" I +TIUDAD S TIUFIX=$$FIXCODE(TIUDAD)"
^MAGD(2006.79,11,1,105,0)="FIXCODX Q TIUFIX"
^MAGD(2006.79,11,1,106,0)="DOCCLASS(TIUTYP) ; Given a document type, find its parent document class"
^MAGD(2006.79,11,1,107,0)=" Q +$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,108,0)="CLINDOC(TIUTYP,TIUDA) ; Given a document type, find the Clinical Document"
^MAGD(2006.79,11,1,109,0)=" ;                 subclass to which it belongs"
^MAGD(2006.79,11,1,110,0)=" N TIUI,TIUY S (TIUI,TIUY)=0"
^MAGD(2006.79,11,1,111,0)=" I +$G(TIUDA),+$$ISADDNDM(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))"
^MAGD(2006.79,11,1,112,0)=" S TIUI=$O(^TIU(8925.1,""AD"",+TIUTYP,TIUI))"
^MAGD(2006.79,11,1,113,0)=" I +TIUI'>0 G CLINDOX"
^MAGD(2006.79,11,1,114,0)=" I TIUI=38 S TIUY=TIUTYP"
^MAGD(2006.79,11,1,115,0)=" I TIUI'=38 S TIUY=$$CLINDOC(TIUI)"
^MAGD(2006.79,11,1,116,0)="CLINDOX Q TIUY"
^MAGD(2006.79,11,1,117,0)="REQVER(TIUTYP,TIUDA) ; Does a given document type require verification"
^MAGD(2006.79,11,1,118,0)=" N TIUDPRM,TIUY"
^MAGD(2006.79,11,1,119,0)=" I +$G(TIUDA),+$$ISADDNDM(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))"
^MAGD(2006.79,11,1,120,0)=" D DOCPRM(TIUTYP,.TIUDPRM)"
^MAGD(2006.79,11,1,121,0)=" I +$P($G(TIUDPRM(0)),U,3) S TIUY=1"
^MAGD(2006.79,11,1,122,0)=" Q +$G(TIUY)"
^MAGD(2006.79,11,1,123,0)="REFDATE(TIU,TIUDICDT) ; Identify Reference date"
^MAGD(2006.79,11,1,124,0)=" N TIURDT"
^MAGD(2006.79,11,1,125,0)=" I +$G(TIU(""LDT"")) S TIURDT=+$G(TIU(""LDT""))_""^0"""
^MAGD(2006.79,11,1,126,0)=" I +$G(TIU(""LDT""))'>0 D"
^MAGD(2006.79,11,1,127,0)=" . S TIURDT=$S(+$G(TIUDICDT):+$G(TIUDICDT),1:+$$NOW^TIULC)_""^1"""
^MAGD(2006.79,11,1,128,0)=" . S TIU(""LDT"")=TIURDT_U_$$DATE^TIULS(TIURDT,""AMTH DD, CCYY@HR:MIN:SEC"")"
^MAGD(2006.79,11,1,129,0)=" Q TIURDT"
^MAGD(2006.79,11,1,130,0)="WHATMPL(USER) ; What List Template should a given user get?"
^MAGD(2006.79,11,1,131,0)=" N TIUY"
^MAGD(2006.79,11,1,132,0)=" I +$$ISA^USRLM(USER,""PROVIDER"") S TIUY=""TIU BROWSE FOR CLINICIAN"" G WHAX"
^MAGD(2006.79,11,1,133,0)=" I +$$ISA^USRLM(USER,""MEDICAL RECORDS TECHNICIAN"") S TIUY=""TIU BROWSE FOR MRT"" G WHAX"
^MAGD(2006.79,11,1,134,0)=" I +$$ISA^USRLM(USER,""CHIEF, MIS"") S TIUY=""TIU BROWSE FOR MGR"" G WHAX"
^MAGD(2006.79,11,1,135,0)=" I +$$ISA^USRLM(USER,""MEDICAL STUDENT"") S TIUY=""TIU BROWSE FOR CLINICIAN"" G WHAX"
^MAGD(2006.79,11,1,136,0)=" S TIUY=""TIU BROWSE FOR READ ONLY"""
^MAGD(2006.79,11,1,137,0)="WHAX Q TIUY"
^MAGD(2006.79,11,1,138,0)="SUPPVSIT(TIUTYP) ; Evaluate whether to suppress visit matching"
^MAGD(2006.79,11,1,139,0)=" N TIUI,TIUY S TIUY=0"
^MAGD(2006.79,11,1,140,0)=" I +$P($G(^TIU(8925.1,+TIUTYP,3)),U,3) S TIUY=1 G SUPPVSIX"
^MAGD(2006.79,11,1,141,0)=" I $L($P($G(^TIU(8925.1,+TIUTYP,3)),U,3)),($P($G(^(3)),U,3)=0) S TIUY=0 G SUPPVSIX ; ** SLC/JER - NOIS NYC-1298-11472"
^MAGD(2006.79,11,1,142,0)=" S TIUI=0 F  S TIUI=$O(^TIU(8925.1,""AD"",+TIUTYP,TIUI)) Q:+TIUI'>0!(+TIUY>0)  D"
^MAGD(2006.79,11,1,143,0)=" . S TIUY=+$$SUPPVSIT(+TIUI)"
^MAGD(2006.79,11,1,144,0)="SUPPVSIX Q TIUY"
^MAGD(2006.79,11,1,145,0)="PTNAME(DFN) ; Resolve Patient Name"
^MAGD(2006.79,11,1,146,0)=" N TIUY S TIUY=$P($G(^DPT(DFN,0)),U)"
^MAGD(2006.79,11,1,147,0)=" S:TIUY']"""" TIUY=""NAME UNKNOWN"""
^MAGD(2006.79,11,1,148,0)=" Q TIUY"
^MAGD(2006.79,11,1,149,0)="POSTSIGN(TIUTYP) ; Get Post-Signature Code, support inheritance"
^MAGD(2006.79,11,1,150,0)=" N TIUPOST,TIUDAD"
^MAGD(2006.79,11,1,151,0)=" S TIUPOST=$G(^TIU(8925.1,+TIUTYP,4.9))"
^MAGD(2006.79,11,1,152,0)=" I TIUPOST]"""" G POSTSIGX"
^MAGD(2006.79,11,1,153,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,154,0)=" I +TIUDAD S TIUPOST=$$POSTSIGN(TIUDAD)"
^MAGD(2006.79,11,1,155,0)="POSTSIGX Q TIUPOST"
^MAGD(2006.79,11,1,156,0)="COMMIT(TIUTYP) ; Get Commitment action, support inheritance"
^MAGD(2006.79,11,1,157,0)=" N TIUCOMM,TIUDAD"
^MAGD(2006.79,11,1,158,0)=" S TIUCOMM=$G(^TIU(8925.1,+TIUTYP,4.1))"
^MAGD(2006.79,11,1,159,0)=" I TIUCOMM]"""" G COMMITX"
^MAGD(2006.79,11,1,160,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,161,0)=" I +TIUDAD S TIUCOMM=$$COMMIT(TIUDAD)"
^MAGD(2006.79,11,1,162,0)="COMMITX Q TIUCOMM"
^MAGD(2006.79,11,1,163,0)="RELEASE(TIUTYP) ; Get Release Action, support inheritance"
^MAGD(2006.79,11,1,164,0)=" N TIUREL,TIUDAD"
^MAGD(2006.79,11,1,165,0)=" S TIUREL=$G(^TIU(8925.1,+TIUTYP,4.2))"
^MAGD(2006.79,11,1,166,0)=" I TIUREL]"""" G RELEASX"
^MAGD(2006.79,11,1,167,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,168,0)=" I +TIUDAD S TIUREL=$$RELEASE(TIUDAD)"
^MAGD(2006.79,11,1,169,0)="RELEASX Q TIUREL"
^MAGD(2006.79,11,1,170,0)="VERIFY(TIUTYP) ; Get Verification action, support inheritance"
^MAGD(2006.79,11,1,171,0)=" N TIUVER,TIUDAD"
^MAGD(2006.79,11,1,172,0)=" S TIUVER=$G(^TIU(8925.1,+TIUTYP,4.3))"
^MAGD(2006.79,11,1,173,0)=" I TIUVER]"""" G VERIFYX"
^MAGD(2006.79,11,1,174,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,175,0)=" I +TIUDAD S TIUVER=$$VERIFY(TIUDAD)"
^MAGD(2006.79,11,1,176,0)="VERIFYX Q TIUVER"
^MAGD(2006.79,11,1,177,0)="DELETE(TIUTYP) ; Get Delete Action, support inheritance"
^MAGD(2006.79,11,1,178,0)=" N TIUDEL,TIUDAD"
^MAGD(2006.79,11,1,179,0)=" S TIUDEL=$G(^TIU(8925.1,+TIUTYP,4.4))"
^MAGD(2006.79,11,1,180,0)=" I TIUDEL]"""" G DELETEX"
^MAGD(2006.79,11,1,181,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,182,0)=" I +TIUDAD S TIUDEL=$$DELETE(TIUDAD)"
^MAGD(2006.79,11,1,183,0)="DELETEX Q TIUDEL"
^MAGD(2006.79,11,1,184,0)="REASSIGN(TIUTYP) ; Get Package Reassign Action, support inheritance"
^MAGD(2006.79,11,1,185,0)=" N TIUREASS,TIUDAD"
^MAGD(2006.79,11,1,186,0)=" S TIUREASS=$G(^TIU(8925.1,+TIUTYP,4.45))"
^MAGD(2006.79,11,1,187,0)=" I TIUREASS]"""" G REASSIX"
^MAGD(2006.79,11,1,188,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,189,0)=" I +TIUDAD S TIUREASS=$$REASSIGN(TIUDAD)"
^MAGD(2006.79,11,1,190,0)="REASSIX Q TIUREASS"
^MAGD(2006.79,11,1,191,0)="ONBROWSE(TIUTYP)        ; Get OnBrowse Event, support inheritance"
^MAGD(2006.79,11,1,192,0)=" N TIUBRWS,TIUDAD"
^MAGD(2006.79,11,1,193,0)=" S TIUBRWS=$G(^TIU(8925.1,+TIUTYP,6.5))"
^MAGD(2006.79,11,1,194,0)=" I TIUBRWS]"""" G ONBRWSX"
^MAGD(2006.79,11,1,195,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,196,0)=" I +TIUDAD S TIUBRWS=$$ONBROWSE(TIUDAD)"
^MAGD(2006.79,11,1,197,0)="ONBRWSX Q TIUBRWS"
^MAGD(2006.79,11,1,198,0)="ONRTRCT(TIUTYP) ; Get OnRetract Event, support inheritance"
^MAGD(2006.79,11,1,199,0)=" N TIURTRCT,TIUDAD"
^MAGD(2006.79,11,1,200,0)=" S TIURTRCT=$G(^TIU(8925.1,+TIUTYP,6.51))"
^MAGD(2006.79,11,1,201,0)=" I TIURTRCT]"""" G ONRTRX"
^MAGD(2006.79,11,1,202,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
^MAGD(2006.79,11,1,203,0)=" I +TIUDAD S TIURTRCT=$$ONRTRCT(TIUDAD)"
^MAGD(2006.79,11,1,204,0)="ONRTRX Q TIURTRCT"
^MAGD(2006.79,11,1,205,0)="DIVISION(TIULOC) ; Get Division"
^MAGD(2006.79,11,1,206,0)=" ; Input  -- TIULOC  HOSPITAL LOCATION file (#44) IEN"
^MAGD(2006.79,11,1,207,0)=" ; Output -- TIUIN   INSTITUTION file (#4) IEN^"
^MAGD(2006.79,11,1,208,0)=" ;                   INSTITUTION file (#4) NAME"
^MAGD(2006.79,11,1,209,0)=" N TIUDVHL,TIUSTN,TIUIN"
^MAGD(2006.79,11,1,210,0)=" S TIUDVHL=$P($G(^SC(+TIULOC,0)),U,15)"
^MAGD(2006.79,11,1,211,0)=" I +TIUDVHL D"
^MAGD(2006.79,11,1,212,0)=" . S TIUSTN=$$SITE^VASITE(,TIUDVHL)"
^MAGD(2006.79,11,1,213,0)=" . I $P(TIUSTN,U)>0,($P(TIUSTN,U,2)]"""") D"
^MAGD(2006.79,11,1,214,0)=" . . S TIUIN=$P(TIUSTN,U)_U_$P(TIUSTN,U,2)"
^MAGD(2006.79,11,1,215,0)=" I '$G(TIUIN) D"
^MAGD(2006.79,11,1,216,0)=" . S TIUIN=+$G(DUZ(2))_U_$P($$NS^XUAF4(+$G(DUZ(2))),U)"
^MAGD(2006.79,11,1,217,0)=" Q TIUIN"
^MAGD(2006.79,12,0)="TIULS^3050311.125837"
^MAGD(2006.79,12,1,0)="^2006.791^104^104"
^MAGD(2006.79,12,1,1,0)="TIULS ; SLC/JER - String Library functions ;10/7/94  17:18 [1/5/04 11:29am]"
^MAGD(2006.79,12,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**178**;Jun 20, 1997"
^MAGD(2006.79,12,1,3,0)=" ;"
^MAGD(2006.79,12,1,4,0)=" ;                   **** WARNING ****"
^MAGD(2006.79,12,1,5,0)=" ;"
^MAGD(2006.79,12,1,6,0)=" ; Any patch which makes ANY changes to this rtn must include a"
^MAGD(2006.79,12,1,7,0)=" ;note in the patch desc reminding sites to update the Imaging"
^MAGD(2006.79,12,1,8,0)=" ;Gateway.  See IA # 3622."
^MAGD(2006.79,12,1,9,0)=" ; IN ADDITION, if changes are made to components used by Imaging,"
^MAGD(2006.79,12,1,10,0)=" ;namely, MIXED, backward compatibility may not be enough. If"
^MAGD(2006.79,12,1,11,0)=" ;changes call additional rtns, TIU should consult with Imaging"
^MAGD(2006.79,12,1,12,0)=" ;on need to add additional rtns to list of TIU rtns copied for"
^MAGD(2006.79,12,1,13,0)=" ;Imaging Gateway."
^MAGD(2006.79,12,1,14,0)=" ;                         ****"
^MAGD(2006.79,12,1,15,0)=" ;"
^MAGD(2006.79,12,1,16,0)="TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS)."
^MAGD(2006.79,12,1,17,0)=" N HR,MIN,SEC,TIUI"
^MAGD(2006.79,12,1,18,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""HR:MIN"""
^MAGD(2006.79,12,1,19,0)=" S X=$P(X,""."",2),HR=$E(X,1,2)_$E(""00"",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E(""00"",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E(""00"",0,2-$L($E(X,5,6)))"
^MAGD(2006.79,12,1,20,0)=" F TIUI=""HR"",""MIN"",""SEC"" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)"
^MAGD(2006.79,12,1,21,0)=" Q FMT"
^MAGD(2006.79,12,1,22,0)="DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date (""MM/DD"")"
^MAGD(2006.79,12,1,23,0)=" N AMTH,MM,CC,DD,YY,TIUI,TIUTMP"
^MAGD(2006.79,12,1,24,0)=" I +X'>0 S $P(TIUTMP,"" "",$L($G(FMT))+1)="""",FMT=TIUTMP G QDATE"
^MAGD(2006.79,12,1,25,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""MM/DD/YY"""
^MAGD(2006.79,12,1,26,0)=" S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)"
^MAGD(2006.79,12,1,27,0)=" S:FMT[""AMTH"" AMTH=$P(""JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"",""^"",+MM)"
^MAGD(2006.79,12,1,28,0)=" F TIUI=""AMTH"",""MM"",""DD"",""CC"",""YY"" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)"
^MAGD(2006.79,12,1,29,0)=" I FMT[""HR"" S FMT=$$TIME(X,FMT)"
^MAGD(2006.79,12,1,30,0)="QDATE Q FMT"
^MAGD(2006.79,12,1,31,0)="NAME(X,FMT) ; Call with X=""LAST,FIRST MI"", FMT=Return Format (""LAST, FI"")"
^MAGD(2006.79,12,1,32,0)=" N TIULAST,TIULI,TIUFIRST,TIUFI,TIUMI,TIUI"
^MAGD(2006.79,12,1,33,0)=" I X']"""" S FMT="""" G NAMEX"
^MAGD(2006.79,12,1,34,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""LAST,FIRST"""
^MAGD(2006.79,12,1,35,0)=" S FMT=$$LOWER(FMT)"
^MAGD(2006.79,12,1,36,0)=" S TIULAST=$P(X,"",""),TIULI=$E(TIULAST),TIUFIRST=$P(X,"","",2)"
^MAGD(2006.79,12,1,37,0)=" S TIUFI=$E(TIUFIRST)"
^MAGD(2006.79,12,1,38,0)=" S TIUMI=$S($P(TIUFIRST,"" "",2)'=""NMI"":$E($P(TIUFIRST,"" "",2)),1:"""")"
^MAGD(2006.79,12,1,39,0)=" S TIUFIRST=$P(TIUFIRST,"" "")"
^MAGD(2006.79,12,1,40,0)=" F TIUI=""last"",""li"",""first"",""fi"",""mi"" I FMT[TIUI S FMT=$P(FMT,TIUI)_@(""TIU""_$$UPPER(TIUI))_$P(FMT,TIUI,2)"
^MAGD(2006.79,12,1,41,0)="NAMEX Q FMT"
^MAGD(2006.79,12,1,42,0)="INAME(X) ; Call with X=""FIRST MI[.] LAST[,M.D.]"", RETURNS ""LAST,FIRST MI"""
^MAGD(2006.79,12,1,43,0)=" N LAST,FIRST,MIDDLE,NAME,MI"
^MAGD(2006.79,12,1,44,0)=" I X'?1.A1"" "".E S NAME=X G INAMEX"
^MAGD(2006.79,12,1,45,0)=" S NAME=$P(X,"",""),FIRST=$P(NAME,"" ""),MIDDLE=$S($L(NAME,"" "")=3:$P(NAME,"" "",2),1:"""")"
^MAGD(2006.79,12,1,46,0)=" S LAST=$P(NAME,"" "",$L(NAME,"" "")),MI=$S($L(MIDDLE):$E(MIDDLE),1:"""")"
^MAGD(2006.79,12,1,47,0)=" S NAME=LAST_"",""_FIRST_$S($L(MI):"" ""_MI,1:"""")"
^MAGD(2006.79,12,1,48,0)="INAMEX Q NAME"
^MAGD(2006.79,12,1,49,0)="WORD(X,FMT) ; Call with X=Word Processing array root, FMT=Wrap Width"
^MAGD(2006.79,12,1,50,0)=" N X,DIWL,DIWF,TIUI K ^UTILITY($J,""W"")"
^MAGD(2006.79,12,1,51,0)=" S DIWL=2,DIWF=""WRC""_FMT"
^MAGD(2006.79,12,1,52,0)=" S TIUI=0 F  S TIUI=$O(@X@(TIUI)) Q:TIUI'>0  S X=^(TIUI,0) D ^DIWP"
^MAGD(2006.79,12,1,53,0)=" D ^DIWW K ^UTILITY($J,""W"")"
^MAGD(2006.79,12,1,54,0)=" Q """""
^MAGD(2006.79,12,1,55,0)="UPPER(X) ; Convert lower case X to UPPER CASE"
^MAGD(2006.79,12,1,56,0)=" Q $TR(X,""abcdefghijklmnopqrstuvwxyz"",""ABCDEFGHIJKLMNOPQRSTUVWXYZ"")"
^MAGD(2006.79,12,1,57,0)="LOWER(X) ; Convert UPPER CASE X to lower case"
^MAGD(2006.79,12,1,58,0)=" Q $TR(X,""ABCDEFGHIJKLMNOPQRSTUVWXYZ"",""abcdefghijklmnopqrstuvwxyz"")"
^MAGD(2006.79,12,1,59,0)="MIXED(X) ; Return Mixed Case X"
^MAGD(2006.79,12,1,60,0)=" N TIUI,WORD,TMP"
^MAGD(2006.79,12,1,61,0)=" S TMP="""" F TIUI=1:1:$L(X,"" "") S WORD=$$UPPER($E($P(X,"" "",TIUI)))_$$LOWER($E($P(X,"" "",TIUI),2,$L($P(X,"" "",TIUI)))),TMP=$S(TMP="""":WORD,1:TMP_"" ""_WORD)"
^MAGD(2006.79,12,1,62,0)=" Q TMP"
^MAGD(2006.79,12,1,63,0)="STRIP(TEXT) ; Strips white space from text"
^MAGD(2006.79,12,1,64,0)=" N TIUTI,TIUX"
^MAGD(2006.79,12,1,65,0)=" ; First remove TABS"
^MAGD(2006.79,12,1,66,0)=" F TIUTI=1:1:$L(TEXT) S:$A(TEXT,TIUTI)=9 TEXT=$E(TEXT,1,(TIUTI-1))_"" ""_$E(TEXT,(TIUTI+1),$L(TEXT))"
^MAGD(2006.79,12,1,67,0)=" S TIUX="""" F TIUTI=1:1:$L(TEXT,"" "") S:$A($P(TEXT,"" "",TIUTI))>0 TIUX=TIUX_$S(TIUTI=1:"""",1:"" "")_$P(TEXT,"" "",TIUTI)"
^MAGD(2006.79,12,1,68,0)=" S TEXT=TIUX S:$P(TEXT,"" "")']"""" TEXT=$P(TEXT,"" "",2,$L(TEXT,"" ""))"
^MAGD(2006.79,12,1,69,0)=" Q TEXT"
^MAGD(2006.79,12,1,70,0)="SIGNAME(TIUDA) ; Get/Return Signature Block Printed Name"
^MAGD(2006.79,12,1,71,0)=" Q $P($G(^VA(200,+TIUDA,20)),U,2)"
^MAGD(2006.79,12,1,72,0)="SIGTITL(TIUDA) ; Get/Return Signature Block Printed Name"
^MAGD(2006.79,12,1,73,0)=" Q $P($G(^VA(200,+TIUDA,20)),U,3)"
^MAGD(2006.79,12,1,74,0)="CENTER(X) ; Center X"
^MAGD(2006.79,12,1,75,0)=" N SP"
^MAGD(2006.79,12,1,76,0)=" S $P(SP,"" "",((IOM-$L(X))\2))="""""
^MAGD(2006.79,12,1,77,0)=" Q $G(SP)_X"
^MAGD(2006.79,12,1,78,0)="URGENCY(X) ; Input transform for urgency codes"
^MAGD(2006.79,12,1,79,0)=" Q $S($$UPPER(X)=""STAT"":""P"",1:$E(X))"
^MAGD(2006.79,12,1,80,0)="FILL(X,Y,LEN) ; Append "", ""_X to Y, unless Y would excede LEN"
^MAGD(2006.79,12,1,81,0)=" Q $S('$L(Y):X,($L(Y_$C(44)_"" ""_X)'>LEN):Y_$C(44)_"" ""_X,1:X)"
^MAGD(2006.79,12,1,82,0)="PARSE(X,Y) ; Parse string X, return array Y with list of words from X"
^MAGD(2006.79,12,1,83,0)=" N I,WORD"
^MAGD(2006.79,12,1,84,0)=" F I=1:1:$L(X,"" "") D"
^MAGD(2006.79,12,1,85,0)=" . S WORD=$P(X,"" "",I),WORD=$TR(WORD,"".,!&?/|\{}[];:=+*^%$#@~`""""><"")"
^MAGD(2006.79,12,1,86,0)=" . S:WORD]"""" Y(I)=$$UPPER(WORD)"
^MAGD(2006.79,12,1,87,0)=" Q"
^MAGD(2006.79,12,1,88,0)="HASNUM(X) ; Boolean - evaluates whether X contains a number"
^MAGD(2006.79,12,1,89,0)=" N I,Y F I=0:1:9 I X[I S Y=1"
^MAGD(2006.79,12,1,90,0)=" Q +$G(Y)"
^MAGD(2006.79,12,1,91,0)="WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH"
^MAGD(2006.79,12,1,92,0)=" N TIUI,TIUJ,LINE,TIUX,TIUX1,TIUX2,TIUY"
^MAGD(2006.79,12,1,93,0)=" I $G(TEXT)']"""" Q """""
^MAGD(2006.79,12,1,94,0)=" F TIUI=1:1 D  Q:TIUI=$L(TEXT,"" "")"
^MAGD(2006.79,12,1,95,0)=" . S TIUX=$P(TEXT,"" "",TIUI)"
^MAGD(2006.79,12,1,96,0)=" . I $L(TIUX)>LENGTH D"
^MAGD(2006.79,12,1,97,0)=" . . S TIUX1=$E(TIUX,1,LENGTH),TIUX2=$E(TIUX,LENGTH+1,$L(TIUX))"
^MAGD(2006.79,12,1,98,0)=" . . S $P(TEXT,"" "",TIUI)=TIUX1_"" ""_TIUX2"
^MAGD(2006.79,12,1,99,0)=" S LINE=1,TIUX(1)=$P(TEXT,"" "")"
^MAGD(2006.79,12,1,100,0)=" F TIUI=2:1 D  Q:TIUI'<$L(TEXT,"" "")"
^MAGD(2006.79,12,1,101,0)=" . S:$L($G(TIUX(LINE))_"" ""_$P(TEXT,"" "",TIUI))>LENGTH LINE=LINE+1,TIUY=1"
^MAGD(2006.79,12,1,102,0)=" . S TIUX(LINE)=$G(TIUX(LINE))_$S(+$G(TIUY):"""",1:"" "")_$P(TEXT,"" "",TIUI),TIUY=0"
^MAGD(2006.79,12,1,103,0)=" S TIUJ=0,TEXT="""" F TIUI=1:1 S TIUJ=$O(TIUX(TIUJ)) Q:+TIUJ'>0  S TEXT=TEXT_$S(TIUI=1:"""",1:""|"")_TIUX(TIUJ)"
^MAGD(2006.79,12,1,104,0)=" Q TEXT"
^MAGD(2006.79,13,0)="TIUSRVPL^3050311.125837"
^MAGD(2006.79,13,1,0)="^2006.791^36^36"
^MAGD(2006.79,13,1,1,0)="TIUSRVPL ; SLC/JER - RPC's Supporting Links ;4/20/2001 09:46"
^MAGD(2006.79,13,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**63,114**;Jun 20, 1997"
^MAGD(2006.79,13,1,3,0)="PUTIMAGE(TIUY,TIUDA,IMGDA) ; Create link Image-to-Document"
^MAGD(2006.79,13,1,4,0)=" N D,D0,DI,DQ,DIC,DA,DIE,DR,X,Y"
^MAGD(2006.79,13,1,5,0)=" I $S('+$G(IMGDA):1,'$D(^MAG(2005,+IMGDA,0)):1,1:0) D  Q"
^MAGD(2006.79,13,1,6,0)=" . S TIUY=""0^ Invalid Image Pointer."""
^MAGD(2006.79,13,1,7,0)=" I $S('+$G(TIUDA):1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D  Q"
^MAGD(2006.79,13,1,8,0)=" . S TIUY=""0^ Invalid Document Pointer."""
^MAGD(2006.79,13,1,9,0)=" I $$DUPLINK(TIUDA,IMGDA) S TIUY=""0^ Document already linked to this image."" Q"
^MAGD(2006.79,13,1,10,0)=" S X=""""""""_""`""_TIUDA_"""""""",(DIC,DLAYGO)=8925.91,DIC(0)=""LX"""
^MAGD(2006.79,13,1,11,0)=" D ^DIC I +Y'>0 S TIUY=""0^ Unable to create Image Link"" Q"
^MAGD(2006.79,13,1,12,0)=" S TIUY=+Y"
^MAGD(2006.79,13,1,13,0)=" S DIE=DIC,DR="".02////^S X=IMGDA"" D ^DIE"
^MAGD(2006.79,13,1,14,0)=" Q"
^MAGD(2006.79,13,1,15,0)="DUPLINK(TIUDA,IMGDA) ; identify duplicate links"
^MAGD(2006.79,13,1,16,0)=" Q $S(+$O(^TIU(8925.91,""ADI"",+TIUDA,+IMGDA,0)):1,1:0)"
^MAGD(2006.79,13,1,17,0)="DELIMAGE(TIUY,TIUDA,IMGDA) ; Delete link Image-to-Document"
^MAGD(2006.79,13,1,18,0)=" N TIUI"
^MAGD(2006.79,13,1,19,0)=" I '+$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA,0)) D  Q"
^MAGD(2006.79,13,1,20,0)=" . S TIUY=""0^ Document and Image not currently linked."""
^MAGD(2006.79,13,1,21,0)=" S TIUI=0"
^MAGD(2006.79,13,1,22,0)=" F  S TIUI=$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA,TIUI)) Q:+TIUI'>0  D"
^MAGD(2006.79,13,1,23,0)=" . N DIDEL,DIE,DA,DR"
^MAGD(2006.79,13,1,24,0)=" . S (DIE,DIDEL)=8925.91,DR="".01///@"",DA=TIUI D ^DIE"
^MAGD(2006.79,13,1,25,0)=" S TIUY=1"
^MAGD(2006.79,13,1,26,0)=" Q"
^MAGD(2006.79,13,1,27,0)="GETILST(TIUY,TIUDA) ; Given a document, get list of associated images"
^MAGD(2006.79,13,1,28,0)=" N IMGDA,TIUI S (IMGDA,TIUI)=0"
^MAGD(2006.79,13,1,29,0)=" F  S IMGDA=$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA)) Q:+IMGDA'>0  D"
^MAGD(2006.79,13,1,30,0)=" . S TIUI=TIUI+1,TIUY(TIUI)=IMGDA"
^MAGD(2006.79,13,1,31,0)=" Q"
^MAGD(2006.79,13,1,32,0)="GETDLST(TIUY,IMGDA) ; Given an Image, get list of associated documents"
^MAGD(2006.79,13,1,33,0)=" N TIUDA,TIUI S (TIUDA,TIUI)=0"
^MAGD(2006.79,13,1,34,0)=" F  S TIUDA=$O(^TIU(8925.91,""AID"",IMGDA,TIUDA)) Q:+TIUDA'>0  D"
^MAGD(2006.79,13,1,35,0)=" . S TIUI=TIUI+1,TIUY(TIUI)=TIUDA"
^MAGD(2006.79,13,1,36,0)=" Q"
^MAGD(2006.79,14,0)="VADPT^3050311.125837"
^MAGD(2006.79,14,1,0)="^2006.791^106^106"
^MAGD(2006.79,14,1,1,0)="VADPT ;ALB/MRL/MJK - RETURN PATIENT VARIABLE ARRAYS [DRIVER];07 DEC 1988"
^MAGD(2006.79,14,1,2,0)=" ;;5.3;Registration;**193,343,389,415,489,498**;Aug 13, 1993"
^MAGD(2006.79,14,1,3,0)=" ;DFN = Patient IFN [if not passed entire array returned as null]"
^MAGD(2006.79,14,1,4,0)=" ;"
^MAGD(2006.79,14,1,5,0)="DEM ;Demographic Variables"
^MAGD(2006.79,14,1,6,0)=" S VAN=1,VAN(1)=12,VAV=""VADM"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,7,0)=" ;"
^MAGD(2006.79,14,1,8,0)="OPD ;Other Patient Data"
^MAGD(2006.79,14,1,9,0)=" S VAN=2,VAN(1)=7,VAV=""VAPD"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,10,0)=" ;"
^MAGD(2006.79,14,1,11,0)="ADD ;Current Address"
^MAGD(2006.79,14,1,12,0)=" S VAN=3,VAN(1)=22,VAV=""VAPA"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,13,0)=" ;"
^MAGD(2006.79,14,1,14,0)="OAD ;Other Patient Variables"
^MAGD(2006.79,14,1,15,0)=" S VAN=4,VAN(1)=11,VAV=""VAOA"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,16,0)=" ;"
^MAGD(2006.79,14,1,17,0)="INP ;Inpatient Data [pre-version 5]"
^MAGD(2006.79,14,1,18,0)=" N VAINDTT S VAN=5,VAN(1)=11,VAV=""VAIN"",VAINDTT=$G(VAINDT) N VAINDT S:VAINDTT VAINDT=$$DATIM(VAINDTT) D ^VADPT0 Q"
^MAGD(2006.79,14,1,19,0)=" ;"
^MAGD(2006.79,14,1,20,0)="IN5 ;Inpatient Data [v5.0 and above]"
^MAGD(2006.79,14,1,21,0)=" N VAINDTT S VAN=6,VAN(1)=19,VAV=$S('$D(VAIP(""V"")):""VAIP"",VAIP(""V"")'?1A.E:""VAIP"",1:VAIP(""V"")),VAINDTT=$G(VAIP(""D"")) S:$L(VAINDTT) VAIP(""D"")=VAINDTT S:VAINDTT VAIP(""D"")=$$DATIM(VAINDTT) D ^VADPT0 S:$L(VAINDTT) VAIP(""D"")=VAINDTT Q"
^MAGD(2006.79,14,1,22,0)=" ;"
^MAGD(2006.79,14,1,23,0)="ELIG ;Eligibility Information"
^MAGD(2006.79,14,1,24,0)=" S VAN=7,VAN(1)=9,VAV=""VAEL"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,25,0)=" ;"
^MAGD(2006.79,14,1,26,0)="MB ;Monetary Benefits"
^MAGD(2006.79,14,1,27,0)=" S VAN=8,VAN(1)=9,VAV=""VAMB"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,28,0)=" ;"
^MAGD(2006.79,14,1,29,0)="SVC ;Service Information"
^MAGD(2006.79,14,1,30,0)=" S VAN=9,VAN(1)=9,VAV=""VASV"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,31,0)=" ;"
^MAGD(2006.79,14,1,32,0)="REG ;Registration data"
^MAGD(2006.79,14,1,33,0)=" S VAN=10,VAV=""VARP"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,34,0)=" ;"
^MAGD(2006.79,14,1,35,0)="SDE ;Enrollment Information"
^MAGD(2006.79,14,1,36,0)=" S VAN=11,VAV=""VAEN"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,37,0)=" ;"
^MAGD(2006.79,14,1,38,0)="SDA ;Appointment Information"
^MAGD(2006.79,14,1,39,0)=" S VAN=12,VAV=""VASD"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,40,0)=" ;"
^MAGD(2006.79,14,1,41,0)="PID ;Patient Id"
^MAGD(2006.79,14,1,42,0)=" S VAN=13,VAV=""VA"" D ^VADPT0 Q"
^MAGD(2006.79,14,1,43,0)=" ;"
^MAGD(2006.79,14,1,44,0)="TESTPAT(DFN)    ;Test patient ?  Returns 0 (No) or 1 (Yes)"
^MAGD(2006.79,14,1,45,0)=" S DFN=+$G(DFN) I 'DFN Q 0"
^MAGD(2006.79,14,1,46,0)=" I $D(^DPT(""ATEST"",DFN)) Q 1"
^MAGD(2006.79,14,1,47,0)=" N NODE S NODE=$G(^DPT(DFN,0))"
^MAGD(2006.79,14,1,48,0)=" I $P(NODE,""^"",21)=1 Q 1"
^MAGD(2006.79,14,1,49,0)=" I $E($P(NODE,""^"",9),1,5)=""00000"" Q 1"
^MAGD(2006.79,14,1,50,0)=" Q 0"
^MAGD(2006.79,14,1,51,0)=" ;"
^MAGD(2006.79,14,1,52,0)="V5 S X=$S($D(^DG(43,1,""VERSION"")):+^(""VERSION""),1:""""),VADPT(""V"")=$S(X<5:0,1:1) K X Q"
^MAGD(2006.79,14,1,53,0)="OERR ;"
^MAGD(2006.79,14,1,54,0)="1 S VATAG=1 D MULT Q"
^MAGD(2006.79,14,1,55,0)="2 S VATAG=2 D MULT Q"
^MAGD(2006.79,14,1,56,0)="3 S VATAG=3 D MULT Q"
^MAGD(2006.79,14,1,57,0)="4 S VATAG=4 D MULT Q"
^MAGD(2006.79,14,1,58,0)="5 S VATAG=5 D MULT Q"
^MAGD(2006.79,14,1,59,0)="6 S VATAG=6 D MULT Q"
^MAGD(2006.79,14,1,60,0)="7 S VATAG=7 D MULT Q"
^MAGD(2006.79,14,1,61,0)="8 S VATAG=8 D MULT Q"
^MAGD(2006.79,14,1,62,0)="9 S VATAG=9 D MULT Q"
^MAGD(2006.79,14,1,63,0)="10 S VATAG=10 D MULT Q"
^MAGD(2006.79,14,1,64,0)="51 S VATAG=11 D MULT Q"
^MAGD(2006.79,14,1,65,0)="52 S VATAG=12 D MULT Q"
^MAGD(2006.79,14,1,66,0)="53 S VATAG=13 D MULT Q"
^MAGD(2006.79,14,1,67,0)="ALL S VATAG=14 D MULT Q"
^MAGD(2006.79,14,1,68,0)="A5 S VATAG=15 D MULT Q"
^MAGD(2006.79,14,1,69,0)="SEL Q:$O(VARRAY(0))']""""  S VATAG=0,VATAG(2)=$P($T(TAG),"";;"",2)"
^MAGD(2006.79,14,1,70,0)=" F VATAG(1)=0:0 S VATAG=$O(VARRAY(VATAG)) Q:VATAG=""""  I VATAG(2)[(""^""_VATAG_""^"") S VARRAY(VATAG)=1,VAROOT=$S($D(VAROOT(VATAG)):VAROOT(VATAG),1:"""") D @VATAG"
^MAGD(2006.79,14,1,71,0)=" G Q"
^MAGD(2006.79,14,1,72,0)=" ;"
^MAGD(2006.79,14,1,73,0)="MULT S VATAG=$P($T(TG+VATAG),"";;"",2)"
^MAGD(2006.79,14,1,74,0)=" F VATAG(1)=1:1 S VATAG(2)=$P(VATAG,""^"",VATAG(1)) Q:VATAG(2)=""""  S VAROOT=$S($D(VAROOT(VATAG(2))):VAROOT(VATAG(2)),1:"""") D @(VATAG(2))"
^MAGD(2006.79,14,1,75,0)="Q S VAROOT="""" K:$D(VAROOT)'=11 VAROOT K VATAG Q"
^MAGD(2006.79,14,1,76,0)=" ;"
^MAGD(2006.79,14,1,77,0)="KVA K VA"
^MAGD(2006.79,14,1,78,0)="KVAR D KVAR^VADPT0 K:$D(VAIP(""V"")) @(VAIP(""V"")) K I,X,Y,VARRAY,VADM,VAPD,VADPT,VAOA,VASV,VAEL,VAMB,VARP,VAEN,VASD,VAIN,VAIP,VAPA,VAHOW,VAINDT,VAERR,^UTILITY(""VADPT"",$J),VA200,VATEST Q"
^MAGD(2006.79,14,1,79,0)="DATIM(DATIM) ;If time not specified see if movement on that date"
^MAGD(2006.79,14,1,80,0)=" Q:DATIM'?7N DATIM"
^MAGD(2006.79,14,1,81,0)=" N A,B S A=$O(^DGPM(""ADFN""_DFN,DATIM)),B=+$O(^(+A,0))"
^MAGD(2006.79,14,1,82,0)=" I 'A Q DATIM"
^MAGD(2006.79,14,1,83,0)=" I $P($G(^DGPM(+B,0)),""^"",2)=3 Q DATIM  ;Next movement is discharge"
^MAGD(2006.79,14,1,84,0)=" F  Q:""^4^5^7^""'[(U_$P($G(^DGPM(+B,0)),""^"",2))  S A=$O(^DGPM(""ADFN""_DFN,A)),B=+$O(^(+A,0)) I $E(A,1,7)'=DATIM Q"
^MAGD(2006.79,14,1,85,0)=" I 'A Q DATIM"
^MAGD(2006.79,14,1,86,0)=" I $E(A,1,7)'=DATIM Q DATIM"
^MAGD(2006.79,14,1,87,0)=" Q A"
^MAGD(2006.79,14,1,88,0)=" ;"
^MAGD(2006.79,14,1,89,0)="TG ;"
^MAGD(2006.79,14,1,90,0)=" ;;DEM^INP"
^MAGD(2006.79,14,1,91,0)=" ;;DEM^ELIG"
^MAGD(2006.79,14,1,92,0)=" ;;ELIG^INP"
^MAGD(2006.79,14,1,93,0)=" ;;DEM^ADD"
^MAGD(2006.79,14,1,94,0)=" ;;ADD^INP"
^MAGD(2006.79,14,1,95,0)=" ;;DEM^ELIG^ADD"
^MAGD(2006.79,14,1,96,0)=" ;;ELIG^SVC"
^MAGD(2006.79,14,1,97,0)=" ;;ELIG^SVC^MB"
^MAGD(2006.79,14,1,98,0)=" ;;DEM^REG^SDE^SDA"
^MAGD(2006.79,14,1,99,0)=" ;;SDE^SDA"
^MAGD(2006.79,14,1,100,0)=" ;;DEM^IN5"
^MAGD(2006.79,14,1,101,0)=" ;;ELIG^IN5"
^MAGD(2006.79,14,1,102,0)=" ;;ADD^IN5"
^MAGD(2006.79,14,1,103,0)=" ;;DEM^OPD^INP^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA"
^MAGD(2006.79,14,1,104,0)=" ;;DEM^OPD^IN5^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA"
^MAGD(2006.79,14,1,105,0)=" ;"
^MAGD(2006.79,14,1,106,0)="TAG ;;^DEM^OPD^INP^IN5^ADD^OAD^ELIG^SVC^MB^REG^SDE^SDA^"
^MAGD(2006.79,15,0)="VADPT0^3050311.125837"
^MAGD(2006.79,15,1,0)="^2006.791^100^100"
^MAGD(2006.79,15,1,1,0)="VADPT0 ;ALB/MRL/MJK - PATIENT VARIABLE ROUTINE DRIVER, CONT.; 12 DEC 1988"
^MAGD(2006.79,15,1,2,0)=" ;;5.3;Registration;**343,342,415,489,498,528**;Aug 13, 1993"
^MAGD(2006.79,15,1,3,0)=" ;"
^MAGD(2006.79,15,1,4,0)=" ;Initialize variables"
^MAGD(2006.79,15,1,5,0)=" N I1"
^MAGD(2006.79,15,1,6,0)=" S U=""^"" D DT^DICRW:'$D(DT)"
^MAGD(2006.79,15,1,7,0)=" S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(DFN,0)):1,1:0)"
^MAGD(2006.79,15,1,8,0)=" S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"""" S Y=0,VAV=VAROOT K @VAV"
^MAGD(2006.79,15,1,9,0)=" I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV=""^UTILITY(""_""""""""_VAV_""""""""_"",""_$J_"")"""
^MAGD(2006.79,15,1,10,0)=" D @VAN"
^MAGD(2006.79,15,1,11,0)="Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q"
^MAGD(2006.79,15,1,12,0)=" ;"
^MAGD(2006.79,15,1,13,0)="INIT ; -- determine #'s or names then init array"
^MAGD(2006.79,15,1,14,0)=" ;"
^MAGD(2006.79,15,1,15,0)=" S VAS=""1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25"""
^MAGD(2006.79,15,1,16,0)=" I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),"";;"",2)"
^MAGD(2006.79,15,1,17,0)=" I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,""^"",I))="""""
^MAGD(2006.79,15,1,18,0)=" Q"
^MAGD(2006.79,15,1,19,0)=" ;"
^MAGD(2006.79,15,1,20,0)="1 ; -- [DEM] demos "
^MAGD(2006.79,15,1,21,0)=" D C1,INIT I 'VAERR D 1^VADPT1,13 Q"
^MAGD(2006.79,15,1,22,0)=" ;"
^MAGD(2006.79,15,1,23,0)="2 ; -- [OPD] other pt vars"
^MAGD(2006.79,15,1,24,0)=" D C2,INIT,2^VADPT1:'VAERR Q"
^MAGD(2006.79,15,1,25,0)=" ;"
^MAGD(2006.79,15,1,26,0)="3 ; -- [ADD] current address"
^MAGD(2006.79,15,1,27,0)=" D C3,INIT,3^VADPT1:'VAERR Q"
^MAGD(2006.79,15,1,28,0)=" ;"
^MAGD(2006.79,15,1,29,0)="4 ; -- [OAD] other pt vars"
^MAGD(2006.79,15,1,30,0)=" D C4,INIT,4^VADPT1:'VAERR Q"
^MAGD(2006.79,15,1,31,0)=" ;"
^MAGD(2006.79,15,1,32,0)="5 ; -- [INP] inpt data -v5"
^MAGD(2006.79,15,1,33,0)=" D C5,INIT,5^VADPT2:'VAERR Q"
^MAGD(2006.79,15,1,34,0)=" ;"
^MAGD(2006.79,15,1,35,0)="6 ; -- [IN5] inpt data v5"
^MAGD(2006.79,15,1,36,0)=" D C6,INIT F I=13:1:17 F I1=1:1:7 S @VAV@($P(VAS,""^"",I),I1)="""""
^MAGD(2006.79,15,1,37,0)=" F I=1:1:3 S @VAV@($P(VAS,""^"",19),I)="""""
^MAGD(2006.79,15,1,38,0)=" D 6^VADPT3:'VAERR Q"
^MAGD(2006.79,15,1,39,0)=" ;"
^MAGD(2006.79,15,1,40,0)="7 ; -- [ELIG] elig data"
^MAGD(2006.79,15,1,41,0)=" D C7,INIT F I=1:1:6 S @VAV@($P(VAS,""^"",5),I)="""""
^MAGD(2006.79,15,1,42,0)=" D 7^VADPT4:'VAERR Q"
^MAGD(2006.79,15,1,43,0)=" ;"
^MAGD(2006.79,15,1,44,0)="8 ; -- [MB] $ benefits"
^MAGD(2006.79,15,1,45,0)=" D C8,INIT D 8^VADPT4:'VAERR Q"
^MAGD(2006.79,15,1,46,0)=" ;"
^MAGD(2006.79,15,1,47,0)="9 ; -- [SVC] service data"
^MAGD(2006.79,15,1,48,0)=" D C9,INIT F I=1:1:9 S @VAV@($P(VAS,""^"",I),1)="""",@VAV@($P(VAS,""^"",I),2)="""""
^MAGD(2006.79,15,1,49,0)=" S @VAV@($P(VAS,""^"",10),1)="""""
^MAGD(2006.79,15,1,50,0)=" S @VAV@($P(VAS,""^"",4),3)="""",@VAV@($P(VAS,""^"",5),3)="""""
^MAGD(2006.79,15,1,51,0)=" F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,""^"",I),I1)="""""
^MAGD(2006.79,15,1,52,0)=" D 9^VADPT4:'VAERR Q"
^MAGD(2006.79,15,1,53,0)=" ;"
^MAGD(2006.79,15,1,54,0)="10 ; -- [REG] registration data"
^MAGD(2006.79,15,1,55,0)=" D C10,INIT D 10^VADPT5:'VAERR Q"
^MAGD(2006.79,15,1,56,0)=" ;"
^MAGD(2006.79,15,1,57,0)="11 ; -- [SDE] clinic enrollment data"
^MAGD(2006.79,15,1,58,0)=" D C11,INIT D 11^VADPT5:'VAERR Q"
^MAGD(2006.79,15,1,59,0)=" ;"
^MAGD(2006.79,15,1,60,0)="12 ; -- [SDA] appt data"
^MAGD(2006.79,15,1,61,0)=" D C12,INIT D 12^VADPT5:'VAERR Q"
^MAGD(2006.79,15,1,62,0)=" ;"
^MAGD(2006.79,15,1,63,0)="13 ; -- [PID] pt id's"
^MAGD(2006.79,15,1,64,0)=" S (VA(""PID""),VA(""BID""))="""" D 13^VADPT6:'VAERR Q"
^MAGD(2006.79,15,1,65,0)=" ;"
^MAGD(2006.79,15,1,66,0)="KVAR ; kill all vadpt data"
^MAGD(2006.79,15,1,67,0)=" K VAN"
^MAGD(2006.79,15,1,68,0)="C1 K ^UTILITY(""VADM"",$J),VADM Q:$D(VAN)"
^MAGD(2006.79,15,1,69,0)="C2 K ^UTILITY(""VAPD"",$J),VAPD Q:$D(VAN)"
^MAGD(2006.79,15,1,70,0)="C3 K X S:$D(VAPA(""P"")) X(""P"")=VAPA(""P"")"
^MAGD(2006.79,15,1,71,0)=" S:$D(VAPA(""CD"")) X(""CD"")=VAPA(""CD"")"
^MAGD(2006.79,15,1,72,0)=" K ^UTILITY(""VAPA"",$J),VAPA"
^MAGD(2006.79,15,1,73,0)=" S:$D(X(""P"")) VAPA(""P"")=X(""P"") K X(""P"")"
^MAGD(2006.79,15,1,74,0)=" S:$D(X(""CD"")) VAPA(""CD"")=X(""CD"") K X Q:$D(VAN)"
^MAGD(2006.79,15,1,75,0)="C4 K X S:$D(VAOA(""A"")) X(""A"")=VAOA(""A"")"
^MAGD(2006.79,15,1,76,0)=" K ^UTILITY(""VAOA"",$J),VAOA"
^MAGD(2006.79,15,1,77,0)=" S:$D(X(""A"")) VAOA(""A"")=X(""A"") K X Q:$D(VAN)"
^MAGD(2006.79,15,1,78,0)="C5 K ^UTILITY(""VAIN"",$J),VAIN Q:$D(VAN)"
^MAGD(2006.79,15,1,79,0)="C6 K X F I=""D"",""E"",""L"",""M"",""V"" I $D(VAIP(I)) S X(I)=VAIP(I)"
^MAGD(2006.79,15,1,80,0)=" S Y=$S('$D(VAIP(""V"")):""VAIP"",VAIP(""V"")'?1A.E:""VAIP"",1:VAIP(""V"")) K ^UTILITY(Y,$J),@Y"
^MAGD(2006.79,15,1,81,0)=" F I=""D"",""E"",""L"",""M"",""V"" I $D(X(I)) S VAIP(I)=X(I)"
^MAGD(2006.79,15,1,82,0)=" K X Q:$D(VAN)"
^MAGD(2006.79,15,1,83,0)="C7 K ^UTILITY(""VAEL"",$J),VAEL Q:$D(VAN)"
^MAGD(2006.79,15,1,84,0)="C8 K ^UTILITY(""VAMB"",$J),VAMB Q:$D(VAN)"
^MAGD(2006.79,15,1,85,0)="C9 K ^UTILITY(""VASV"",$J),VASV Q:$D(VAN)"
^MAGD(2006.79,15,1,86,0)="C10 K ^UTILITY(""VARP"",$J) Q:$D(VAN)"
^MAGD(2006.79,15,1,87,0)="C11 K ^UTILITY(""VAEN"",$J) Q:$D(VAN)"
^MAGD(2006.79,15,1,88,0)="C12 K ^UTILITY(""VASD"",$J) Q"
^MAGD(2006.79,15,1,89,0)="C13 Q"
^MAGD(2006.79,15,1,90,0)=" ;"
^MAGD(2006.79,15,1,91,0)="SS ;  1^ 2^ 3^ 4^ 5^ 6^ 7^ 8^ 9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25"
^MAGD(2006.79,15,1,92,0)=" ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC"
^MAGD(2006.79,15,1,93,0)=" ;;BC^BS^FN^MN^MM^OC^ES"
^MAGD(2006.79,15,1,94,0)=" ;;L1^L2^L3^CI^ST^ZP^CO^PN^TS^TE^Z4^CCA^CL1^CL2^CL3^CCI^CST^CZP^CCO^CCS^CCE^CTY"
^MAGD(2006.79,15,1,95,0)=" ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4"
^MAGD(2006.79,15,1,96,0)=" ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP"
^MAGD(2006.79,15,1,97,0)=" ;;MN^TT^MD^MT^WL^RB^DR^TS^MF^BS^RD^PT^AN^LN^PN^NN^DN^AP^FD"
^MAGD(2006.79,15,1,98,0)=" ;;EL^PS^SC^VT^IN^TY^CN^ES^MT"
^MAGD(2006.79,15,1,99,0)=" ;;AA^HB^SS^PE^MR^SI^DI^OR^GI"
^MAGD(2006.79,15,1,100,0)=" ;;VN^AO^IR^PW^CS^S1^S2^S3^PH"
^MAGD(2006.79,16,0)="VADPT1^3050311.125837"
^MAGD(2006.79,16,1,0)="^2006.791^126^126"
^MAGD(2006.79,16,1,1,0)="VADPT1 ;ALB/MRL/MJK - PATIENT VARIABLES ; 08 DEC 1988 ; 11/9/04 6:17pm"
^MAGD(2006.79,16,1,2,0)=" ;;5.3;Registration;**415,489,516,614**;Aug 13, 1993"
^MAGD(2006.79,16,1,3,0)="1 ;Demographic [DEM]"
^MAGD(2006.79,16,1,4,0)=" N W,Z,NODE"
^MAGD(2006.79,16,1,5,0)=" ;"
^MAGD(2006.79,16,1,6,0)=" ; -- name [1 - NM]"
^MAGD(2006.79,16,1,7,0)=" S VAX=^DPT(DFN,0),@VAV@($P(VAS,""^"",1))=$P(VAX,""^"")"
^MAGD(2006.79,16,1,8,0)=" ;"
^MAGD(2006.79,16,1,9,0)=" ; -- ssn [2 - SS]"
^MAGD(2006.79,16,1,10,0)=" S Z=$P(VAX,""^"",9) S:Z]"""" @VAV@($P(VAS,""^"",2))=Z_$S(Z]"""":""^""_$E(Z,1,3)_""-""_$E(Z,4,5)_""-""_$E(Z,6,10),1:"""")"
^MAGD(2006.79,16,1,11,0)=" ;"
^MAGD(2006.79,16,1,12,0)=" ; -- date of birth [2 - DB]"
^MAGD(2006.79,16,1,13,0)=" S Z=$P(VAX,""^"",3),Y=Z I Y]"""" X ^DD(""DD"") S @VAV@($P(VAS,""^"",3))=Z_""^""_Y"
^MAGD(2006.79,16,1,14,0)=" ;"
^MAGD(2006.79,16,1,15,0)=" ; -- age [4 - AG]"
^MAGD(2006.79,16,1,16,0)=" S W=$S('$D(^DPT(DFN,.35)):"""",'^(.35):"""",1:+^(.35)) S Y=$S('W:DT,1:W) S:Z]"""" @VAV@($P(VAS,""^"",4))=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7))"
^MAGD(2006.79,16,1,17,0)=" ;"
^MAGD(2006.79,16,1,18,0)=" ; -- expired date [6 - EX]"
^MAGD(2006.79,16,1,19,0)=" S (Y,Z)=W X:Y]"""" ^DD(""DD"") S:Z]"""" @VAV@($P(VAS,""^"",6))=Z_""^""_Y"
^MAGD(2006.79,16,1,20,0)=" ;"
^MAGD(2006.79,16,1,21,0)=" ; -- sex [5 - SX]"
^MAGD(2006.79,16,1,22,0)=" S Z=$P(VAX,""^"",2) S:Z]"""" @VAV@($P(VAS,""^"",5))=Z_""^""_$S(Z=""M"":""MALE"",Z=""F"":""FEMALE"",1:"""") K Z"
^MAGD(2006.79,16,1,23,0)=" ;"
^MAGD(2006.79,16,1,24,0)=" ; -- remarks [7 - RE]"
^MAGD(2006.79,16,1,25,0)=" S @VAV@($P(VAS,""^"",7))=$P(VAX,""^"",10)"
^MAGD(2006.79,16,1,26,0)=" ;"
^MAGD(2006.79,16,1,27,0)=" ; -- historic race [8 - RA]"
^MAGD(2006.79,16,1,28,0)=" S Z=$P(VAX,""^"",6),@VAV@($P(VAS,""^"",8))=Z_$S($D(^DIC(10,+Z,0)):""^""_$P(^(0),""^""),1:"""")"
^MAGD(2006.79,16,1,29,0)=" ;"
^MAGD(2006.79,16,1,30,0)=" ; -- religion [9 - RP]"
^MAGD(2006.79,16,1,31,0)=" S Z=$P(VAX,""^"",8),@VAV@($P(VAS,""^"",9))=Z_$S($D(^DIC(13,+Z,0)):""^""_$P(^(0),""^""),1:"""")"
^MAGD(2006.79,16,1,32,0)=" ;"
^MAGD(2006.79,16,1,33,0)=" ; -- marital status [10 - MS]"
^MAGD(2006.79,16,1,34,0)=" S Z=$P(VAX,""^"",5),@VAV@($P(VAS,""^"",10))=Z_$S($D(^DIC(11,+Z,0)):""^""_$P(^(0),""^""),1:"""")"
^MAGD(2006.79,16,1,35,0)=" ;"
^MAGD(2006.79,16,1,36,0)=" ; -- ethnicity [11 - ET]"
^MAGD(2006.79,16,1,37,0)=" S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.06,X)) Q:'X  D"
^MAGD(2006.79,16,1,38,0)=" .S NODE=$G(^DPT(DFN,.06,X,0)),Z=$P(NODE,""^"",1) I Z D"
^MAGD(2006.79,16,1,39,0)=" ..S @VAV@($P(VAS,""^"",11),Y)=Z_""^""_$P($G(^DIC(10.2,Z,0)),""^"",1)"
^MAGD(2006.79,16,1,40,0)=" ..; -- collection method"
^MAGD(2006.79,16,1,41,0)=" ..S Z=$P(NODE,""^"",2) I Z D"
^MAGD(2006.79,16,1,42,0)=" ...S @VAV@($P(VAS,""^"",11),Y,1)=Z_""^""_$P($G(^DIC(10.3,Z,0)),""^"",1)"
^MAGD(2006.79,16,1,43,0)=" S @VAV@($P(VAS,""^"",11))=Y-1"
^MAGD(2006.79,16,1,44,0)=" ;"
^MAGD(2006.79,16,1,45,0)=" ; -- race [12 - RC]"
^MAGD(2006.79,16,1,46,0)=" S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.02,X)) Q:'X  D"
^MAGD(2006.79,16,1,47,0)=" .S NODE=$G(^DPT(DFN,.02,X,0)),Z=$P(NODE,""^"",1) I Z D"
^MAGD(2006.79,16,1,48,0)=" ..S @VAV@($P(VAS,""^"",12),Y)=Z_""^""_$P($G(^DIC(10,Z,0)),""^"",1)"
^MAGD(2006.79,16,1,49,0)=" ..; -- collection method"
^MAGD(2006.79,16,1,50,0)=" ..S Z=$P(NODE,""^"",2) I Z D"
^MAGD(2006.79,16,1,51,0)=" ...S @VAV@($P(VAS,""^"",12),Y,1)=Z_""^""_$P($G(^DIC(10.3,Z,0)),""^"",1)"
^MAGD(2006.79,16,1,52,0)=" S @VAV@($P(VAS,""^"",12))=Y-1"
^MAGD(2006.79,16,1,53,0)=" Q"
^MAGD(2006.79,16,1,54,0)=" ;"
^MAGD(2006.79,16,1,55,0)="2 ;Other Patient Variables [OPD]"
^MAGD(2006.79,16,1,56,0)=" N W,Z"
^MAGD(2006.79,16,1,57,0)=" S VAX=^DPT(DFN,0)"
^MAGD(2006.79,16,1,58,0)=" ;"
^MAGD(2006.79,16,1,59,0)=" ; -- city of birth [1 - BC]"
^MAGD(2006.79,16,1,60,0)=" S @VAV@($P(VAS,""^"",1))=$P(VAX,""^"",11)"
^MAGD(2006.79,16,1,61,0)=" ;"
^MAGD(2006.79,16,1,62,0)=" ; -- state of birth [2 - BS]"
^MAGD(2006.79,16,1,63,0)=" S Z=$P(VAX,""^"",12),@VAV@($P(VAS,""^"",2))=Z_$S($D(^DIC(5,+Z,0)):""^""_$P(^(0),""^"",1),1:"""")"
^MAGD(2006.79,16,1,64,0)=" ;"
^MAGD(2006.79,16,1,65,0)=" ; -- occupation [6 - OC]"
^MAGD(2006.79,16,1,66,0)=" S @VAV@($P(VAS,""^"",6))=$P(VAX,""^"",7)"
^MAGD(2006.79,16,1,67,0)=" ;"
^MAGD(2006.79,16,1,68,0)=" ; -- names"
^MAGD(2006.79,16,1,69,0)=" S VAX=$S($D(^DPT(DFN,.24)):^(.24),1:"""")"
^MAGD(2006.79,16,1,70,0)=" S @VAV@($P(VAS,""^"",3))=$P(VAX,""^"",1) ; father's        [3 - FN]"
^MAGD(2006.79,16,1,71,0)=" S @VAV@($P(VAS,""^"",4))=$P(VAX,""^"",2) ; mother's        [4 - MN]"
^MAGD(2006.79,16,1,72,0)=" S @VAV@($P(VAS,""^"",5))=$P(VAX,""^"",3) ; mother's maiden [5 - MM]"
^MAGD(2006.79,16,1,73,0)=" ;"
^MAGD(2006.79,16,1,74,0)=" ; -- employment status [7 - ES]"
^MAGD(2006.79,16,1,75,0)=" S VAX=$S($D(^DPT(DFN,.311)):^(.311),1:""""),W=""EMPLOYED FULL TIME^EMPLOYED PART TIME^NOT EMPLOYED^SELF EMPLOYED^RETIRED^ACTIVE MILITARY DUTY^UNKNOWN"""
^MAGD(2006.79,16,1,76,0)=" S Z=$P(VAX,""^"",15),@VAV@($P(VAS,""^"",7))=Z_$S(Z:""^""_$P(W,""^"",Z),1:"""")"
^MAGD(2006.79,16,1,77,0)=" Q"
^MAGD(2006.79,16,1,78,0)=" ;"
^MAGD(2006.79,16,1,79,0)="3 ;Address [ADD]"
^MAGD(2006.79,16,1,80,0)=" S VABEG=$S($D(VATEST(""ADD"",9)):VATEST(""ADD"",9),1:DT),VAEND=$S($D(VATEST(""ADD"",10)):VATEST(""ADD"",10),1:DT)"
^MAGD(2006.79,16,1,81,0)=" I $S($D(VAPA(""P"")):1,'$D(^DPT(DFN,.121)):1,$P(^(.121),""^"",9)'=""Y"":1,'$P(^(.121),""^"",7):1,$P(^(.121),""^"",7)>VABEG:1,'$P(^(.121),""^"",8):0,1:$P(^(.121),""^"",8)<VAEND) S VAX=$S($D(^DPT(DFN,.11)):^(.11),1:""""),VAX(1)=0"
^MAGD(2006.79,16,1,82,0)=" E  S VAX=$S($D(^DPT(DFN,.121)):^(.121),1:""""),VAX(1)=1"
^MAGD(2006.79,16,1,83,0)=" F I=1:1:6 S VAZ=$P(VAX,""^"",I),@VAV@($P(VAS,""^"",I))=VAZ I I=5,$D(^DIC(5,+VAZ,0)) S VAZ=$P(^(0),""^""),@VAV@($P(VAS,""^"",5))=@VAV@($P(VAS,""^"",5))_""^""_VAZ"
^MAGD(2006.79,16,1,84,0)=" S VAZ=$S('VAX(1):$P(VAX,""^"",7),1:$P(VAX,""^"",11)) S:$D(^DIC(5,+$P(VAX,""^"",5),1,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",7))=VAZ"
^MAGD(2006.79,16,1,85,0)=" S VAZIP4=$P(VAX,U,12)"
^MAGD(2006.79,16,1,86,0)=" S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"""",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_""-""_$E(VAZIP4,6,9))"
^MAGD(2006.79,16,1,87,0)=" ;DG*5.3*516"
^MAGD(2006.79,16,1,88,0)=" I $D(^DPT(DFN,.13)) S @VAV@($P(VAS,""^"",8))=$P(^(.13),""^"",1)"
^MAGD(2006.79,16,1,89,0)=" I 'VAX(1) G CA"
^MAGD(2006.79,16,1,90,0)=" S @VAV@($P(VAS,""^"",8))=$P(VAX,""^"",10)"
^MAGD(2006.79,16,1,91,0)=" F I=7,8 S VAZ=$P(VAX,""^"",I),Y=VAZ X:Y]"""" ^DD(""DD"") S @VAV@($P(VAS,""^"",I+2))=VAZ_""^""_Y"
^MAGD(2006.79,16,1,92,0)="CA ;Confidential Address"
^MAGD(2006.79,16,1,93,0)=" I '$D(^DPT(DFN,.141)) G Q3"
^MAGD(2006.79,16,1,94,0)=" N VACAT,VAACT,VAACTDT,VATYP,VATYPNAM,VACAN"
^MAGD(2006.79,16,1,95,0)=" S VAX=$S($D(^DPT(DFN,.141)):^(.141),1:"""")"
^MAGD(2006.79,16,1,96,0)=" S VAACTDT=$S($D(VAPA(""CD"")):VAPA(""CD""),1:DT)"
^MAGD(2006.79,16,1,97,0)=" F I=1:1:6 S VAZ=$P(VAX,""^"",I),@VAV@($P(VAS,""^"",I+12))=VAZ D"
^MAGD(2006.79,16,1,98,0)=" .I I=5,$D(^DIC(5,+VAZ,0)) S VAZ=$P(^(0),""^""),@VAV@($P(VAS,""^"",I+12))=@VAV@($P(VAS,""^"",I+12))_""^""_VAZ Q"
^MAGD(2006.79,16,1,99,0)=" .I I=6,($G(VAZ)]"""") S @VAV@($P(VAS,""^"",I+12))=@VAV@($P(VAS,""^"",I+12))_""^""_$S(($L(VAZ)=5):VAZ,1:$E(VAZ,1,5)_""-""_$E(VAZ,6,9))"
^MAGD(2006.79,16,1,100,0)=" S VAZ=$P(VAX,""^"",11) S:$D(^DIC(5,+$P(VAX,""^"",5),1,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",19))=VAZ"
^MAGD(2006.79,16,1,101,0)=" F I=7,8 S VAZ=$P(VAX,""^"",I),Y=VAZ X:Y]"""" ^DD(""DD"") S @VAV@($P(VAS,""^"",I+13))=VAZ_""^""_Y"
^MAGD(2006.79,16,1,102,0)=" S VABEG=$P(VAX,""^"",7),VAEND=$P(VAX,""^"",8)"
^MAGD(2006.79,16,1,103,0)=" S @VAV@($P(VAS,""^"",12))=1"
^MAGD(2006.79,16,1,104,0)=" I 'VABEG!(VABEG>VAACTDT)!(VAEND&(VAEND<VAACTDT)) S @VAV@($P(VAS,""^"",12))=0"
^MAGD(2006.79,16,1,105,0)=" I $D(^DPT(DFN,.14)) D"
^MAGD(2006.79,16,1,106,0)=" .S VACAN="""" F  S VACAN=$O(^DPT(DFN,.14,VACAN)) Q:VACAN=""""  D"
^MAGD(2006.79,16,1,107,0)=" ..Q:'$D(^DPT(DFN,.14,VACAN,0))"
^MAGD(2006.79,16,1,108,0)=" ..S VATYP=$P(^DPT(DFN,.14,VACAN,0),""^"",1),VAACT=$P(^DPT(DFN,.14,VACAN,0),""^"",2)"
^MAGD(2006.79,16,1,109,0)=" ..S VACAT=$$GET1^DID(2.141,.01,"""",""POINTER"","""",""DGERR"")"
^MAGD(2006.79,16,1,110,0)=" ..S VATYPNAM="""" F I=1:1 S VATYPNAM=$P(VACAT,"";"",I) Q:VATYPNAM=""""  D"
^MAGD(2006.79,16,1,111,0)=" ...I +VATYPNAM[VATYP S VATYPNAM=$P(VATYPNAM,"":"",2),@VAV@($P(VAS,""^"",22),VATYP)=VATYP_""^""_VATYPNAM_""^""_VAACT"
^MAGD(2006.79,16,1,112,0)="Q3 K VABEG,VAEND,VAZIP4 Q"
^MAGD(2006.79,16,1,113,0)=" ;"
^MAGD(2006.79,16,1,114,0)="4 ;Other Address [OAD]"
^MAGD(2006.79,16,1,115,0)=" N VAZIP4"
^MAGD(2006.79,16,1,116,0)=" I $S('$D(VAOA(""A"")):1,VAOA(""A"")<1:1,VAOA(""A"")>6:1,1:0) S VAX=.21,VAOA(""A"")=7"
^MAGD(2006.79,16,1,117,0)=" E  S VAX="".""_$P(""33^34^211^331^311^25"",""^"",+VAOA(""A""))"
^MAGD(2006.79,16,1,118,0)=" S VAX(1)=VAX,VAX=$S($D(^DPT(DFN,VAX(1))):^(VAX(1)),1:"""") I VAX(1)=.25 S VAX=$P(VAX,""^"",1)_""^^""_$P(VAX,""^"",2,99)"
^MAGD(2006.79,16,1,119,0)=" S VAX(2)=0 F I=3,4,5,6,7,8 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,""^"",VAX(2)))=$P(VAX,""^"",I)"
^MAGD(2006.79,16,1,120,0)=" S @VAV@($P(VAS,""^"",7))="""",@VAV@($P(VAS,""^"",8))=$P(VAX,""^"",9),VAX(2)=8"
^MAGD(2006.79,16,1,121,0)=" F I=1,2 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,""^"",VAX(2)))=$P(VAX,""^"",I)"
^MAGD(2006.79,16,1,122,0)=" I ""^.311^.25""[(""^""_VAX(1)_""^"") S @VAV@($P(VAS,""^"",10))="""""
^MAGD(2006.79,16,1,123,0)=" S VAZ=@VAV@($P(VAS,""^"",5)) I VAZ,$D(^DIC(5,+VAZ,0)) S VAZ(1)=$P(^(0),""^"",1),@VAV@($P(VAS,""^"",5))=VAZ_""^""_VAZ(1)"
^MAGD(2006.79,16,1,124,0)=" S VAZIP4=$P($G(^DPT(DFN,.22)),U,VAOA(""A""))"
^MAGD(2006.79,16,1,125,0)=" S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"""",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_""-""_$E(VAZIP4,6,9))"
^MAGD(2006.79,16,1,126,0)=" Q"
^MAGD(2006.79,17,0)="VADPT2^3050311.125837"
^MAGD(2006.79,17,1,0)="^2006.791^60^60"
^MAGD(2006.79,17,1,1,0)="VADPT2 ;ALB/MJK - ESTABLISH PATIENT VARIABLES ; 3/23/88  9:13 PM ; [10/20/95 4:02pm]"
^MAGD(2006.79,17,1,2,0)=" ;;5.3;Registration;**69**;Aug 13, 1993"
^MAGD(2006.79,17,1,3,0)="5 ; -- INP call"
^MAGD(2006.79,17,1,4,0)=" S (VAWD,VATS,VADX,VAPP,VAAP,VARM)="""" D NOW^%DTC S VANOW=% K VAMV,VAMV0"
^MAGD(2006.79,17,1,5,0)=" I '$D(VAINDT) N VAINDT S VAINDT=VANOW"
^MAGD(2006.79,17,1,6,0)=" S VATD=9999999.999999-VAINDT"
^MAGD(2006.79,17,1,7,0)=" F VAID=VATD:0 S VAID=$O(^DGPM(""APID"",DFN,VAID)) Q:'VAID  S VAMV=$O(^(VAID,0)) D CHK I $D(VAMV) K:""^3^4^5^""[(""^""_VAMT_""^"") VAMV,VAMV0 Q"
^MAGD(2006.79,17,1,8,0)=" ;"
^MAGD(2006.79,17,1,9,0)=" G:'$D(VAMV0) DONE"
^MAGD(2006.79,17,1,10,0)=" S (VAPRT,VAPRC,VACN)=1 D GET^VADPT30"
^MAGD(2006.79,17,1,11,0)=" S VAMV0=^DGPM(VAMV,0),VAMVT=$P(VAMV0,""^"",4),VACA=$P(VAMV0,""^"",14),VACA0=$S($D(^DGPM(+VACA,0)):^(0),1:"""")"
^MAGD(2006.79,17,1,12,0)=" ;"
^MAGD(2006.79,17,1,13,0)=" ; set: adm ifn(1) ; doctor(2) ; tr spec(3) ; ward(4) ; room(5) ; attending (11)"
^MAGD(2006.79,17,1,14,0)=" S @VAV@($P(VAS,""^"",1))=VACA,@VAV@($P(VAS,""^"",2))=VAPP,@VAV@($P(VAS,""^"",3))=VATS,@VAV@($P(VAS,""^"",4))=VAWD,@VAV@($P(VAS,""^"",5))=$P(VARM,""^"",2),@VAV@($P(VAS,""^"",11))=VAAP"
^MAGD(2006.79,17,1,15,0)=" ;"
^MAGD(2006.79,17,1,16,0)=" ; set bed/no bed  mvt type(6)"
^MAGD(2006.79,17,1,17,0)=" D IB S @VAV@($P(VAS,""^"",6))=VAZ"
^MAGD(2006.79,17,1,18,0)=" ;"
^MAGD(2006.79,17,1,19,0)=" ; set adm date(7)"
^MAGD(2006.79,17,1,20,0)=" S Y=+VACA0 X:Y ^DD(""DD"") S @VAV@($P(VAS,""^"",7))=+VACA0_""^""_Y"
^MAGD(2006.79,17,1,21,0)=" ;"
^MAGD(2006.79,17,1,22,0)=" ; set: adm type(8) ; adm dx(9) ; ptf ifn(10)"
^MAGD(2006.79,17,1,23,0)=" S @VAV@($P(VAS,""^"",8))=$P(VACA0,""^"",4)_""^""_$S($D(^DG(405.1,+$P(VACA0,""^"",4),0)):$P(^(0),""^""),1:""""),@VAV@($P(VAS,""^"",9))=$P(VACA0,""^"",10),@VAV@($P(VAS,""^"",10))=$P(VACA0,""^"",16)"
^MAGD(2006.79,17,1,24,0)=" ;"
^MAGD(2006.79,17,1,25,0)="DONE K VAID,VANOW,VACA,VACA0,VAMV,VAMV0,VATD,VAMT,VAMVT D KVAR^VADPT30 Q"
^MAGD(2006.79,17,1,26,0)=" ;"
^MAGD(2006.79,17,1,27,0)="IB ;In-Bed status"
^MAGD(2006.79,17,1,28,0)=" ; input:  VAINDT = internal date of requested info"
^MAGD(2006.79,17,1,29,0)=" ;         VAMV   = starting IFN"
^MAGD(2006.79,17,1,30,0)=" ;         VAMV0  = 0th of VAMV"
^MAGD(2006.79,17,1,31,0)=" ;"
^MAGD(2006.79,17,1,32,0)=" ; output: VAZ    = <O:not in bed OR 1: in bed>^fac. mvt name"
^MAGD(2006.79,17,1,33,0)=" ;         VAZ(2) = abs ret date"
^MAGD(2006.79,17,1,34,0)=" ;"
^MAGD(2006.79,17,1,35,0)=" S VAZ=0,VAZ(2)="""""
^MAGD(2006.79,17,1,36,0)=" S VAXI=+$O(^DGPM(""APMV"",DFN,+$P(VAMV0,""^"",14),9999999.999999-VAINDT)),VAXI=+$O(^(VAXI,0))"
^MAGD(2006.79,17,1,37,0)=" I 'VAXI,$D(VAIP(""L"")),$P(VAMV0,""^"",2)=4 S VAXI=VAMV ; only used via IN5"
^MAGD(2006.79,17,1,38,0)=" G IBQ:'VAXI"
^MAGD(2006.79,17,1,39,0)=" S VAX0=$S($D(^DGPM(VAXI,0)):^(0),1:"""")"
^MAGD(2006.79,17,1,40,0)=" G IBQ:VAX0']"""",IBQ:""^3^5^""[(""^""_$P(VAX0,""^"",2)_""^"")"
^MAGD(2006.79,17,1,41,0)=" S VAXI=$S($D(^DG(405.1,+$P(VAX0,""^"",4),0)):$P(^(0),""^""),1:"""")"
^MAGD(2006.79,17,1,42,0)=" ; -- check in-bed status flag"
^MAGD(2006.79,17,1,43,0)=" S VAZ=$S('$D(^DG(405.2,+$P(VAX0,""^"",18),""E"")):1,1:'^(""E""))_""^""_VAXI,VAZ(2)=$P(VAX0,""^"",13)"
^MAGD(2006.79,17,1,44,0)="IBQ K VAXI,VAX0 Q"
^MAGD(2006.79,17,1,45,0)=" ;"
^MAGD(2006.79,17,1,46,0)="CHK ; -- check if mvt exists and if 'while asih' type d/c"
^MAGD(2006.79,17,1,47,0)=" ;    if VAMV returned undefined then continue $Oing"
^MAGD(2006.79,17,1,48,0)=" ;"
^MAGD(2006.79,17,1,49,0)=" I $D(^DGPM(+VAMV,0)) S VAMV0=^(0),VAMT=$P(VAMV0,""^"",2)"
^MAGD(2006.79,17,1,50,0)=" I '$D(VAMV0) K VAMV G CHKQ"
^MAGD(2006.79,17,1,51,0)=" I ""^42^47^""[(""^""_$P(VAMV0,""^"",18)_""^""),$P(VAMV0,""^"",22)'=2,$O(^DGPM(""APMV"",DFN,+$P(VAMV0,""^"",14),VAID)),$O(^($O(^(VAID)),0)),$D(^DGPM($O(^(0)),0)),""^13^44^""[(""^""_$P(^(0),""^"",18)_""^"") K VAMV,VAMV0"
^MAGD(2006.79,17,1,52,0)=" ; info: 47 mvt can not have seq #; will always be null"
^MAGD(2006.79,17,1,53,0)="CHKQ Q"
^MAGD(2006.79,17,1,54,0)=" ;"
^MAGD(2006.79,17,1,55,0)="ADM ; -- send back adm ifn for dfn on vaindt or now"
^MAGD(2006.79,17,1,56,0)=" S VADT=$S($D(VAINDT):VAINDT,1:"""") I 'VADT D NOW^%DTC S VADT=%"
^MAGD(2006.79,17,1,57,0)=" S VAID=9999999.999999-VADT,VADMVT="""""
^MAGD(2006.79,17,1,58,0)=" F  S VAID=$O(^DGPM(""ATID1"",DFN,VAID)) Q:'VAID  S VAMV=+$O(^DGPM(""ATID1"",DFN,VAID,0)) I $D(^DGPM(VAMV,0)) S VAMV0=^(0),VAMV1=$S($D(^DGPM(+$P(VAMV0,""^"",17),0)):^(0),1:9999999.999999) D  Q:VADMVT!($P(VAMV0,U,18)'=40)"
^MAGD(2006.79,17,1,59,0)=" .I VAMV0'>VADT,VAMV1>VADT S VADMVT=VAMV"
^MAGD(2006.79,17,1,60,0)=" K VAID,VADT,VAMV,VAMV0,VAMV1"
^MAGD(2006.79,18,0)="VADPT3^3050311.125837"
^MAGD(2006.79,18,1,0)="^2006.791^97^97"
^MAGD(2006.79,18,1,1,0)="VADPT3 ;ALB/MRL - PATIENT VARIABLES [IN5]; 12 DEC 1988 ; 7/22/03 5:00pm"
^MAGD(2006.79,18,1,2,0)=" ;;5.3;Registration;**532**;Aug 13, 1993"
^MAGD(2006.79,18,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
^MAGD(2006.79,18,1,4,0)="6 ;"
^MAGD(2006.79,18,1,5,0)=" D NOW^%DTC S (NOW,VAX(""DAT""))=%,NOWI=9999999.999999-%"
^MAGD(2006.79,18,1,6,0)=" ;"
^MAGD(2006.79,18,1,7,0)=" I $D(VAIP(""E"")),$D(^DGPM(+VAIP(""E""),0)) S VAX(""DT"")=+^(0),E=+VAIP(""E"") G GO ;Specific Entry"
^MAGD(2006.79,18,1,8,0)=" ;"
^MAGD(2006.79,18,1,9,0)=" I $D(VAIP(""D"")),""^l^L^""[(""^""_$E(VAIP(""D""))_""^"") D LAST G GO:E,Q"
^MAGD(2006.79,18,1,10,0)=" ;"
^MAGD(2006.79,18,1,11,0)=" S VAX=$S($D(VAIP(""D"")):VAIP(""D""),$D(VAINDT):VAINDT,1:0)"
^MAGD(2006.79,18,1,12,0)=" I VAX S:VAX?7N!(VAX?7N1""."".N) VAX(""DT"")=VAX I '$D(VAX(""DT"")) G Q ;Invalid Entry"
^MAGD(2006.79,18,1,13,0)=" ;"
^MAGD(2006.79,18,1,14,0)=" S:'$D(VAX(""DT"")) VAX(""DT"")=NOW"
^MAGD(2006.79,18,1,15,0)=" I VAX(""DT"")=VAX(""DAT"") S E=$S($D(^DPT(DFN,.102)):+^(.102),1:0),E=$S($D(^DGPM(E,0)):E,1:0) G GO:E D LODGER G GO:E D ASIHOF G GO:E,Q ;Current IP"
^MAGD(2006.79,18,1,16,0)=" ;"
^MAGD(2006.79,18,1,17,0)=" ;Find Past Movement"
^MAGD(2006.79,18,1,18,0)=" S VAX=+$O(^DGPM(""APID"",DFN,9999999.999999-VAX(""DT""))) I 'VAX D LODGER G GO:E,Q"
^MAGD(2006.79,18,1,19,0)=" S VAX=+$O(^DGPM(""APID"",DFN,VAX,0)) I '$D(^DGPM(VAX,0)) D LODGER G GO:E,Q"
^MAGD(2006.79,18,1,20,0)=" S VAZ=^DGPM(VAX,0) D OK G GO:E D LODGER G GO:E,Q"
^MAGD(2006.79,18,1,21,0)=" ;"
^MAGD(2006.79,18,1,22,0)="GO S:'$D(VAX(""DT"")) VAX(""DT"")=NOW D ^VADPT31 ; setting of VAX(""DT"") can be removed??"
^MAGD(2006.79,18,1,23,0)=" ;"
^MAGD(2006.79,18,1,24,0)="Q K NOW,NOWI,VAX,VAZ,VAZ2,E,VACC,VAQ,VANN,VASET,^UTILITY(""VADPTZ"",$J,DFN) D KVAR^VADPT30 Q"
^MAGD(2006.79,18,1,25,0)=" ;"
^MAGD(2006.79,18,1,26,0)="OK N VAADT,VADDT,VAQUIT"
^MAGD(2006.79,18,1,27,0)=" S E=0,VAZ2=""^""_(+$P(VAZ,""^"",18))_""^"""
^MAGD(2006.79,18,1,28,0)=" I ""^13^41^46^""[VAZ2 D OK1 Q:'VAX  G OK"
^MAGD(2006.79,18,1,29,0)=" I ""^42^""[VAZ2 D 42 I 'Y D OK1 Q:'VAX  G OK"
^MAGD(2006.79,18,1,30,0)=" I ""^47^""[VAZ2 D 47 I 'Y D OK1 Q:'VAX  G OK"
^MAGD(2006.79,18,1,31,0)=" I $D(VAX(""DT"")),$P(VAZ,""^"",2)=3,VAZ'>VAX(""DT"") Q"
^MAGD(2006.79,18,1,32,0)=" ;DG*5.3*532"
^MAGD(2006.79,18,1,33,0)=" ;Check for out-of-order disch. recs caused by same day adm./disch."
^MAGD(2006.79,18,1,34,0)=" ;where disch. date < adm. date because disch. date had no time"
^MAGD(2006.79,18,1,35,0)=" I +VAZ<2890000,$D(VAX(""DT"")),$P(VAZ,""^"",2)'=3 S VAQUIT=0 D  Q:VAQUIT"
^MAGD(2006.79,18,1,36,0)=" .S VAADT=$P(VAZ,""^"",14) Q:'VAADT"
^MAGD(2006.79,18,1,37,0)=" .S VADDT=$P($G(^DGPM(VAADT,0)),""^"",17) Q:'VADDT"
^MAGD(2006.79,18,1,38,0)=" .S VADDT=$P($G(^DGPM(VADDT,0)),""^"",14) I $P(VADDT,""."",2)="""",VADDT=$P(VAADT,"".""),VAZ'>VAX(""DT"") S VAQUIT=1"
^MAGD(2006.79,18,1,39,0)=" S E=+VAX Q"
^MAGD(2006.79,18,1,40,0)=" ;"
^MAGD(2006.79,18,1,41,0)="OK1 S VAX=+$O(^DGPM(""APID"",DFN,9999999.9999999-(VAZ+($P(VAZ,""^"",22)/10000000)))),VAX=+$O(^(VAX,0))"
^MAGD(2006.79,18,1,42,0)=" I VAX,$D(^DGPM(VAX,0)) S VAZ=^(0)"
^MAGD(2006.79,18,1,43,0)=" Q"
^MAGD(2006.79,18,1,44,0)=" ;"
^MAGD(2006.79,18,1,45,0)="LAST ; returns last movement for patient"
^MAGD(2006.79,18,1,46,0)=" ; called by bed control and pt inquiry"
^MAGD(2006.79,18,1,47,0)=" S VAX=+$O(^DGPM(""APID"",DFN,NOWI)),E=0"
^MAGD(2006.79,18,1,48,0)=" I $D(VAIP(""L"")) D LLDCHK G LASTQ:E"
^MAGD(2006.79,18,1,49,0)=" S VAX=+$O(^DGPM(""APID"",DFN,VAX,0)) I $D(^DGPM(VAX,0)) S VAZ=^(0) D OK"
^MAGD(2006.79,18,1,50,0)="LASTQ S VAX(""DT"")=NOW"
^MAGD(2006.79,18,1,51,0)=" Q"
^MAGD(2006.79,18,1,52,0)=" ;"
^MAGD(2006.79,18,1,53,0)="LODGER ;"
^MAGD(2006.79,18,1,54,0)=" S E=0 G LODGERQ:'$D(VAIP(""L""))"
^MAGD(2006.79,18,1,55,0)=" I VAX(""DT"")=VAX(""DAT"") S VAX=$S($D(^DPT(DFN,.107)):^(.107),1:"""") G LODGERQ:VAX']"""" S E=$S($D(^DPT(""LD"",VAX,DFN)):+^(DFN),1:0) G LODGERQ"
^MAGD(2006.79,18,1,56,0)=" ;"
^MAGD(2006.79,18,1,57,0)=" S VAX=$O(^DGPM(""ATID4"",DFN,9999999.999999-VAX(""DT""))) S:VAX E=+$O(^DGPM(""ATID4"",DFN,VAX,0))"
^MAGD(2006.79,18,1,58,0)=" I E S E=$S($D(^DGPM(E,0)):E,1:0) I E,$D(^DGPM(+$P(^(0),""^"",17),0)),^(0)'>VAX(""DT"") S E=0"
^MAGD(2006.79,18,1,59,0)="LODGERQ Q"
^MAGD(2006.79,18,1,60,0)=" ;"
^MAGD(2006.79,18,1,61,0)="LLDCHK ; -- last lodger mvt checking ; build array of inverse dates and chk"
^MAGD(2006.79,18,1,62,0)=" N IDT S IDT(VAX)=0"
^MAGD(2006.79,18,1,63,0)=" S IDT=+$O(^DGPM(""ATID4"",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0))"
^MAGD(2006.79,18,1,64,0)=" S IDT=+$O(^DGPM(""ATID5"",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0))"
^MAGD(2006.79,18,1,65,0)=" S IDT=+$O(IDT(0)) I IDT S E=IDT(IDT),E=$S($D(^DGPM(E,0)):E,1:0)"
^MAGD(2006.79,18,1,66,0)=" Q"
^MAGD(2006.79,18,1,67,0)=" ; "
^MAGD(2006.79,18,1,68,0)="CHK ;"
^MAGD(2006.79,18,1,69,0)=" G VAR^VADPT30"
^MAGD(2006.79,18,1,70,0)=" ;"
^MAGD(2006.79,18,1,71,0)="ASIHOF ; -- is last mvt asih oth fac"
^MAGD(2006.79,18,1,72,0)=" S E=0,VAX=$S('$O(^DGPM(""APID"",DFN,NOWI)):"""",1:$O(^DGPM(""APID"",DFN,$O(^(NOWI)),0)))"
^MAGD(2006.79,18,1,73,0)=" I VAX,$D(^DGPM(VAX,0)),""^43^45^""[(""^""_$P(^(0),""^"",18)_""^"") S E=VAX"
^MAGD(2006.79,18,1,74,0)=" Q"
^MAGD(2006.79,18,1,75,0)=" ;"
^MAGD(2006.79,18,1,76,0)="42 ; -- check to see if this mvt can be used; for 'while asih' d/c category"
^MAGD(2006.79,18,1,77,0)=" ;   If Y returned high then mvt is good"
^MAGD(2006.79,18,1,78,0)=" ;"
^MAGD(2006.79,18,1,79,0)=" I VAZ'<VAX(""DAT"") S Y=0 G Q42 ; not a real d/c yet"
^MAGD(2006.79,18,1,80,0)=" I $P(VAZ,""^"",22)=2 S Y=0 G Q42 ; nhcu d/c assoicated w/asih d/c (seq #2)"
^MAGD(2006.79,18,1,81,0)=" D SCAN"
^MAGD(2006.79,18,1,82,0)="Q42 Q"
^MAGD(2006.79,18,1,83,0)=" ;"
^MAGD(2006.79,18,1,84,0)="SCAN ; -- determine is d/c while in other fac(Y=1 returned if so.)"
^MAGD(2006.79,18,1,85,0)=" ;"
^MAGD(2006.79,18,1,86,0)=" N VAID,VACA,M S Y=0,VAID=9999999.999999-VAZ,VACA=+$P(VAZ,""^"",14)"
^MAGD(2006.79,18,1,87,0)=" F VAID=VAID:0 S VAID=$O(^DGPM(""APMV"",DFN,VACA,VAID)) Q:'VAID  I $D(^DGPM(+$O(^(VAID,0)),0)) S M=$P(^(0),""^"",18) I ""^13^44^43^45^""[(""^""_M_""^"") S Y=$S(M=43!(M=45):1,1:0) Q"
^MAGD(2006.79,18,1,88,0)=" Q"
^MAGD(2006.79,18,1,89,0)=" ;"
^MAGD(2006.79,18,1,90,0)="47 ; -- check to see if d/c from nhcu while asih in other fac"
^MAGD(2006.79,18,1,91,0)=" ;   If y returned high then mvt is good."
^MAGD(2006.79,18,1,92,0)=" D SCAN Q"
^MAGD(2006.79,18,1,93,0)=" ;"
^MAGD(2006.79,18,1,94,0)=" ; 13 = to asih (vah)     (xfr)|44 = resume asih in parent facility (xfr)"
^MAGD(2006.79,18,1,95,0)=" ; 41 = from asih         (d/c)|45 = change asih location(other fac)(xfr)"
^MAGD(2006.79,18,1,96,0)=" ; 42 = while asih        (d/c)|46 = continues asih (other fac)     (d/c)"
^MAGD(2006.79,18,1,97,0)=" ; 43 = to asih(other fac)(xfr)|47 = discharge from nhcu while asih (d/c)"
^MAGD(2006.79,19,0)="VADPT30^3050311.125837"
^MAGD(2006.79,19,1,0)="^2006.791^80^80"
^MAGD(2006.79,19,1,1,0)="VADPT30 ;ALB/MJK - Current Inpatient Variables; 12 DEC 1988"
^MAGD(2006.79,19,1,2,0)=" ;;5.3;Registration;**111,498,509**;Aug 13, 1993"
^MAGD(2006.79,19,1,3,0)=" ;"
^MAGD(2006.79,19,1,4,0)="VAR ; -- inpatient demographics variables"
^MAGD(2006.79,19,1,5,0)=" ;  input: DFN, VATD  = inverse date ; VACN  ="
^MAGD(2006.79,19,1,6,0)=" ;              VAPRC =              ; VAPRT ="
^MAGD(2006.79,19,1,7,0)=" ;"
^MAGD(2006.79,19,1,8,0)=" ; output: VAWD = ward ; VATS = tr. spec. ; VARM = room/bed"
^MAGD(2006.79,19,1,9,0)=" ;         VAPP = doc  ; VADX = diagnosis ; VAMV = mv entry"
^MAGD(2006.79,19,1,10,0)=" ;         VAAP = attending physician"
^MAGD(2006.79,19,1,11,0)=" ;         VAFD = answer to facility directory question"
^MAGD(2006.79,19,1,12,0)=" ;"
^MAGD(2006.79,19,1,13,0)=" S (VAWDA,VAWD,VATS,VAMV,VARM,VAPP,VAAP,VADX,VAFD)="""",VAID=VATD"
^MAGD(2006.79,19,1,14,0)=" ; -- get mv"
^MAGD(2006.79,19,1,15,0)=" D MV G VARQ:VAMV0']"""""
^MAGD(2006.79,19,1,16,0)=" S Y=$G(^DGPM(+$P(VAMV0,""^"",14),0)) I $P(Y,""^"",2)=1 D"
^MAGD(2006.79,19,1,17,0)=" .N DCD"
^MAGD(2006.79,19,1,18,0)=" .S DCD=+$P(Y,""^"",17) I DCD S DCD=+$G(^DGPM(DCD,0))"
^MAGD(2006.79,19,1,19,0)=" .S Y=$G(^DGPM(+$P(VAMV0,""^"",14),""DIR""))"
^MAGD(2006.79,19,1,20,0)=" .S Y=$P(Y,""^"",1)"
^MAGD(2006.79,19,1,21,0)=" .I Y="""" S Y=$S('DCD:1,(DCD<3030414.999999):"""",1:1) Q:Y="""""
^MAGD(2006.79,19,1,22,0)=" .S VAFD=Y_""^""_$$EXTERNAL^DILFD(405,41,,Y)"
^MAGD(2006.79,19,1,23,0)=" ; quit if not an adm or xfr"
^MAGD(2006.79,19,1,24,0)=" I ""^1^2^""'[(""^""_$P(VAMV0,""^"",2)_""^"") G VARQ"
^MAGD(2006.79,19,1,25,0)=" I 'VAPRC,""^2^3^13^25^26^43^44^45^""[(""^""_VAMT_""^"") G VARQ"
^MAGD(2006.79,19,1,26,0)=" I VAPRC,""^13^43^44^45^""[(""^""_VAMT_""^"") G VARQ"
^MAGD(2006.79,19,1,27,0)=" S:VAPRC VABO=$S(VAMT<4:VAMT,1:4) D GET"
^MAGD(2006.79,19,1,28,0)=" ;I 'VACN,'VATS S VATS=TSD ;what is this"
^MAGD(2006.79,19,1,29,0)="VARQ K VAMV0,VAMT,VAID"
^MAGD(2006.79,19,1,30,0)=" Q"
^MAGD(2006.79,19,1,31,0)=" ;"
^MAGD(2006.79,19,1,32,0)="GET ; -- get variables and quit when all set(Y=1)"
^MAGD(2006.79,19,1,33,0)=" S VACA=+$P(VAMV0,""^"",14)"
^MAGD(2006.79,19,1,34,0)=" D TS,SET G GETQ:Y"
^MAGD(2006.79,19,1,35,0)=" F VAID=VATD:0 S VAID=$O(^DGPM(""APMV"",DFN,VACA,VAID)) Q:'VAID  F VAIFN=0:0 S VAIFN=$O(^DGPM(""APMV"",DFN,VACA,VAID,VAIFN)) Q:'VAIFN  I $D(^DGPM(VAIFN,0)) S VAMV0=^(0) D SET G GETQ:Y"
^MAGD(2006.79,19,1,36,0)="GETQ K VACA,VAIFN,VAID Q"
^MAGD(2006.79,19,1,37,0)=" ;"
^MAGD(2006.79,19,1,38,0)="KVAR K VAMV,VAWDA,VAWD,VARM,VAPP,VAAP,VATS,VATD,VAPRC,VAPRT,VACN,VADX,VABO,VAFD Q"
^MAGD(2006.79,19,1,39,0)=" ;"
^MAGD(2006.79,19,1,40,0)="SET ; -- set variables if null"
^MAGD(2006.79,19,1,41,0)=" S Y=0"
^MAGD(2006.79,19,1,42,0)=" I 'VAWD,$D(^DIC(42,+$P(VAMV0,""^"",6),0)) S VAWDA=$S($D(VAIFN):VAIFN,1:VAMV),VAWD=$P(VAMV0,""^"",6)_""^""_$P(^(0),""^"") S VARM="""" I $D(^DG(405.4,+$P(VAMV0,""^"",7),0)) S VARM=$P(VAMV0,""^"",7)_""^""_$P(^(0),""^"")"
^MAGD(2006.79,19,1,43,0)=" I 'VACN,VAWD S Y=1"
^MAGD(2006.79,19,1,44,0)=" N VARSTR"
^MAGD(2006.79,19,1,45,0)=" S VARSTR=""^^^^^VAWD^VARM^VAPP^VATS^VADX^^^^^^^^^VAAP^"""
^MAGD(2006.79,19,1,46,0)=" S $P(VARSTR,""^"",41)=""VAFD"""
^MAGD(2006.79,19,1,47,0)=" I VACN,'VAPRT,$D(DGPMDDF),@$P(VARSTR,""^"",+DGPMDDF),VAMV S Y=1"
^MAGD(2006.79,19,1,48,0)=" I VACN,VAPRT,VAWD,VAMV,VADX]"""" S Y=1"
^MAGD(2006.79,19,1,49,0)=" Q"
^MAGD(2006.79,19,1,50,0)=" ;"
^MAGD(2006.79,19,1,51,0)="TS ; set VADX, VATS, VAAP, and VAPP via VACA x-refs"
^MAGD(2006.79,19,1,52,0)=" N VAMV0"
^MAGD(2006.79,19,1,53,0)=" S:$D(^DGPM(VACA,0)) VADX=$P(^(0),""^"",10)"
^MAGD(2006.79,19,1,54,0)=" F VAID=VATD:0 S VAID=$O(^DGPM(""ATS"",DFN,VACA,VAID)) Q:'VAID  F VAT=0:0 S VAT=$O(^DGPM(""ATS"",DFN,VACA,VAID,VAT)) Q:'VAT  F VAIFN=0:0 S VAIFN=$O(^DGPM(""ATS"",DFN,VACA,VAID,VAT,VAIFN)) Q:'VAIFN  D TS1 G TSQ:VAPP&VATS&VAAP"
^MAGD(2006.79,19,1,55,0)="TSQ K VAIFN,VAT Q"
^MAGD(2006.79,19,1,56,0)=" ;"
^MAGD(2006.79,19,1,57,0)="TS1 ; set VATS, VAPP, and VAAP"
^MAGD(2006.79,19,1,58,0)=" Q:'$D(^DGPM(VAIFN,0))  S VAMV0=^(0)"
^MAGD(2006.79,19,1,59,0)=" I 'VAPP,$D(^VA(200,+$P(VAMV0,""^"",8),0)) S Y=$P(VAMV0,""^"",8)_""^""_$P(^(0),""^"") S VAPP=Y"
^MAGD(2006.79,19,1,60,0)=" I 'VAAP,$D(^VA(200,+$P(VAMV0,""^"",19),0)) S Y=$P(VAMV0,""^"",19)_""^""_$P(^(0),""^"") S VAAP=Y"
^MAGD(2006.79,19,1,61,0)=" I 'VATS,$D(^DIC(45.7,+$P(VAMV0,""^"",9),0)) S VATS=$P(VAMV0,""^"",9)_""^""_$P(^(0),""^"")"
^MAGD(2006.79,19,1,62,0)=" Q"
^MAGD(2006.79,19,1,63,0)=" ;"
^MAGD(2006.79,19,1,64,0)="MV ; -- get latest mv for pt before VAID and not ASIH mv"
^MAGD(2006.79,19,1,65,0)=" S (VAMV,VAMV0)="""""
^MAGD(2006.79,19,1,66,0)=" F VAID=VAID:0 S VAID=$O(^DGPM(""APID"",DFN,VAID)) G MVQ:'VAID S VAMV=$O(^DGPM(""APID"",DFN,VAID,0)) I $D(^DGPM(+VAMV,0)) S VAMT=$P(^(0),""^"",18) G MVQ:'VAMT Q:""^13^41^42^47^""'[(""^""_VAMT_""^"")"
^MAGD(2006.79,19,1,67,0)=" S VAMV0=^DGPM(VAMV,0)"
^MAGD(2006.79,19,1,68,0)="MVQ Q"
^MAGD(2006.79,19,1,69,0)=" ;"
^MAGD(2006.79,19,1,70,0)="A ;return current admission or last admission for patient"
^MAGD(2006.79,19,1,71,0)=" S Y=$S($D(^DPT(DFN,.105)):+^(.105),1:0) G AQ:$D(^DGPM(Y,0))"
^MAGD(2006.79,19,1,72,0)=" N VAID,VAMV,VAMV0"
^MAGD(2006.79,19,1,73,0)=" F VAID=0:0 S VAID=$O(^DGPM(""ATID1"",DFN,VAID)) Q:'VAID  F VAMV=0:0 S VAMV=$O(^DGPM(""ATID1"",DFN,VAID,VAMV)) Q:'VAMV  I $D(^DGPM(VAMV,0)) S VAMV0=^(0) D DIS G AQ:Y"
^MAGD(2006.79,19,1,74,0)=" S Y=0"
^MAGD(2006.79,19,1,75,0)="AQ Q"
^MAGD(2006.79,19,1,76,0)=" ;"
^MAGD(2006.79,19,1,77,0)="DIS ; check for ASIH discharges"
^MAGD(2006.79,19,1,78,0)=" S Y=$S('$D(^DGPM(+$P(VAMV0,""^"",17),0)):VAMV,""^41^46""[(U_$P(^(0),""^"",18)_U):0,1:VAMV)"
^MAGD(2006.79,19,1,79,0)=" Q"
^MAGD(2006.79,19,1,80,0)=" ;"
^MAGD(2006.79,20,0)="VADPT31^3050311.125837"
^MAGD(2006.79,20,1,0)="^2006.791^76^76"
^MAGD(2006.79,20,1,1,0)="VADPT31 ;ALB/MRL/MJK - PATIENT VARIABLES [IN5], CONT.; 12 DEC 1988"
^MAGD(2006.79,20,1,2,0)=" ;;5.3;Registration;**498,509**;Aug 13, 1993"
^MAGD(2006.79,20,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
^MAGD(2006.79,20,1,4,0)="EN N VAINDT,VAMV,VAMV0"
^MAGD(2006.79,20,1,5,0)=" S VAMV=+E,VAMV0=^DGPM(VAMV,0),VAX(""CA"")=+$P(VAMV0,""^"",14) G ENQ:'$D(^DGPM(+VAX(""CA""),0))"
^MAGD(2006.79,20,1,6,0)=" I $D(VAIP(""M"")) D CE G ENQ:'$D(^DGPM(+E,0)) S VAMV=+E,VAMV0=^(0)"
^MAGD(2006.79,20,1,7,0)=" S @VAV@($P(VAS,""^"",1))=E"
^MAGD(2006.79,20,1,8,0)=" S Y=$P(VAMV0,""^"",2),@VAV@($P(VAS,""^"",2))=Y_""^""_$S($D(^DG(405.3,+Y,0)):$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,9,0)=" S Y=$S(+VAMV0:+VAMV0,1:"""") X:Y ^DD(""DD"") S @VAV@($P(VAS,""^"",3))=+VAMV0_""^""_Y"
^MAGD(2006.79,20,1,10,0)=" S Y=$P(VAMV0,""^"",18),@VAV@($P(VAS,""^"",4))=Y_""^""_$S($D(^DG(405.2,+Y,0)):$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,11,0)=" S Y=+$P(^DGPM(VAX(""CA""),0),""^"",16) S:Y @VAV@($P(VAS,""^"",12))=Y"
^MAGD(2006.79,20,1,12,0)=" ;"
^MAGD(2006.79,20,1,13,0)=" S VATD=VAX(""DT"") D FIND"
^MAGD(2006.79,20,1,14,0)=" S @VAV@($P(VAS,""^"",5))=VAWD,@VAV@($P(VAS,""^"",6))=VARM,@VAV@($P(VAS,""^"",7))=VAPP,@VAV@($P(VAS,""^"",8))=VATS,@VAV@($P(VAS,""^"",9))=VADX,@VAV@($P(VAS,""^"",18))=VAAP"
^MAGD(2006.79,20,1,15,0)=" ;"
^MAGD(2006.79,20,1,16,0)=" S VANODE=$G(^DGPM(VAX(""CA""),0)) I $P(VANODE,""^"",2)=1  D"
^MAGD(2006.79,20,1,17,0)=" .N DCD"
^MAGD(2006.79,20,1,18,0)=" .S DCD=+$P(VANODE,""^"",17) I DCD S DCD=+$G(^DGPM(DCD,0))"
^MAGD(2006.79,20,1,19,0)=" .S VANODE=$G(^DGPM(VAX(""CA""),""DIR""))"
^MAGD(2006.79,20,1,20,0)=" .S Y=$P(VANODE,""^"",1)"
^MAGD(2006.79,20,1,21,0)=" .I Y="""" S Y=$S('DCD:1,(DCD<3030414.999999):"""",1:1) Q:Y="""""
^MAGD(2006.79,20,1,22,0)=" .S @VAV@($P(VAS,""^"",19),1)=Y_""^""_$$EXTERNAL^DILFD(405,41,,Y)"
^MAGD(2006.79,20,1,23,0)=" .S Y=$P(VANODE,""^"",2) S @VAV@($P(VAS,""^"",19),2)=Y_""^""_$$EXTERNAL^DILFD(405,42,,Y)"
^MAGD(2006.79,20,1,24,0)=" .S Y=$P(VANODE,""^"",3) S @VAV@($P(VAS,""^"",19),3)=Y_""^""_$$EXTERNAL^DILFD(405,43,,Y)"
^MAGD(2006.79,20,1,25,0)=" ;"
^MAGD(2006.79,20,1,26,0)=" S VAINDT=+VAMV0 D IB^VADPT2 S @VAV@($P(VAS,""^"",10))=+VAZ"
^MAGD(2006.79,20,1,27,0)=" I 'VAZ,$D(VAZ(2)),VAZ(2)?7N!(VAZ(2)?7N1""."".N) S Y=VAZ(2) X ^DD(""DD"") S @VAV@($P(VAS,""^"",11))=VAZ(2)_""^""_Y"
^MAGD(2006.79,20,1,28,0)=" ;"
^MAGD(2006.79,20,1,29,0)=" I $D(VAIP(""M"")) S VASET=$S(VAIP(""M""):14,1:13),VASET(VASET)="""",VANODE=$P(VAS,""^"",VASET) D COPY ; last or adm"
^MAGD(2006.79,20,1,30,0)=" I '$D(VAIP(""M"")),$D(VAIP(""D"")),""^l^L^""[(""^""_$E(VAIP(""D""))_""^"") S VASET(14)="""",VANODE=$P(VAS,""^"",14) D COPY ; last"
^MAGD(2006.79,20,1,31,0)=" I ""^3^5^""[(""^""_$P(VAMV0,""^"",2)_""^"") S VASET(17)="""",VANODE=$P(VAS,""^"",17) D COPY ; d/c"
^MAGD(2006.79,20,1,32,0)=" I '$D(VASET(13)) S VAMV=VAX(""CA""),VAMV0=^DGPM(VAMV,0),VANODE=$P(VAS,""^"",13) D STORE ; adm"
^MAGD(2006.79,20,1,33,0)=" D BLD^VADPT32 G ENQ:'$D(^UTILITY(""VADPTZ"",$J,DFN))"
^MAGD(2006.79,20,1,34,0)=" S VAXE=$S($D(^UTILITY(""VADPTZ"",$J,DFN,1)):^(1),1:""""),VAMV0=$P(VAXE,""||"",2),VAMV=+VAXE"
^MAGD(2006.79,20,1,35,0)=" I VAMV,""^3^5^""[(""^""_$P(VAMV0,""^"",2)_""^""),'$D(VASET(17)) S VANODE=$P(VAS,""^"",17) D STORE ; d/c"
^MAGD(2006.79,20,1,36,0)=" I VAMV,'$D(VASET(14)) S VANODE=$P(VAS,""^"",14) D STORE ;last"
^MAGD(2006.79,20,1,37,0)=" I $S('VANN:1,'$D(^UTILITY(""VADPTZ"",$J,DFN,+VANN)):1,1:0) G ENQ"
^MAGD(2006.79,20,1,38,0)=" I $D(^UTILITY(""VADPTZ"",$J,DFN,VANN-1)) S VAXE=^(VANN-1),VAMV=+VAXE,VAMV0=$P(VAXE,""||"",2) I VAMV S VANODE=$P(VAS,""^"",16) D STORE ; following"
^MAGD(2006.79,20,1,39,0)=" I $D(^UTILITY(""VADPTZ"",$J,DFN,VANN+1)) S VAXE=^(VANN+1),VAMV=+VAXE,VAMV0=$P(VAXE,""||"",2) I VAMV S VANODE=$P(VAS,""^"",15) D STORE ; prior"
^MAGD(2006.79,20,1,40,0)=" ;"
^MAGD(2006.79,20,1,41,0)="ENQ K VAMVX,VANODE,VAMCC,VAXE,VANN D KVAR^VADPT30 Q"
^MAGD(2006.79,20,1,42,0)=" ;"
^MAGD(2006.79,20,1,43,0)="FIND ;"
^MAGD(2006.79,20,1,44,0)=" S VAMVX=VAMV,VAMV0X=VAMV0"
^MAGD(2006.79,20,1,45,0)=" S (VAWD,VATS,VAMV,VARM,VAPP,VAAP,VADX)="""""
^MAGD(2006.79,20,1,46,0)=" I $P(VAMV0,""^"",2)=4!($P(VAMV0,""^"",2)=5) D LODGER G FINDQ"
^MAGD(2006.79,20,1,47,0)=" S VATD=9999999.999999-VATD,(VACN,VAPRC,VAPRT)=1 D GET^VADPT30"
^MAGD(2006.79,20,1,48,0)="FINDQ S VAMV=VAMVX,VAMV0=VAMV0X K VAMVX,VAMV0X"
^MAGD(2006.79,20,1,49,0)=" Q"
^MAGD(2006.79,20,1,50,0)=" ;"
^MAGD(2006.79,20,1,51,0)="CE I 'VAIP(""M"") S E=+VAX(""CA"") Q"
^MAGD(2006.79,20,1,52,0)=" S E=$O(^DGPM(""APMV"",DFN,+VAX(""CA""),0)) Q:E'>0  S E=$O(^DGPM(""APMV"",DFN,+VAX(""CA""),E,0)) Q"
^MAGD(2006.79,20,1,53,0)=" ;"
^MAGD(2006.79,20,1,54,0)="STORE ; store 'other nodes'"
^MAGD(2006.79,20,1,55,0)=" S @VAV@(VANODE)=+VAMV"
^MAGD(2006.79,20,1,56,0)=" S Y=+VAMV0 X:Y ^DD(""DD"") S @VAV@(VANODE,1)=+VAMV0_""^""_Y"
^MAGD(2006.79,20,1,57,0)=" S Y=$P(VAMV0,""^"",2),@VAV@(VANODE,2)=Y_""^""_$S($D(^DG(405.3,+Y,0)):$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,58,0)=" S Y=$P(VAMV0,""^"",18),@VAV@(VANODE,3)=Y_""^""_$S($D(^DG(405.2,+Y,0)):$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,59,0)=" S VATD=+VAMV0 D FIND"
^MAGD(2006.79,20,1,60,0)=" S @VAV@(VANODE,4)=VAWD,@VAV@(VANODE,5)=VAPP,@VAV@(VANODE,6)=VATS,@VAV@(VANODE,7)=VADX"
^MAGD(2006.79,20,1,61,0)=" Q"
^MAGD(2006.79,20,1,62,0)=" ;"
^MAGD(2006.79,20,1,63,0)="COPY ; copy from primary to other nodes"
^MAGD(2006.79,20,1,64,0)=" S @VAV@(VANODE)=VAMV"
^MAGD(2006.79,20,1,65,0)=" ; 1-mvt d/t ; 2-transaction type ; 3-mvt type"
^MAGD(2006.79,20,1,66,0)=" S @VAV@(VANODE,1)=@VAV@($P(VAS,""^"",3)),@VAV@(VANODE,2)=@VAV@($P(VAS,""^"",2)),@VAV@(VANODE,3)=@VAV@($P(VAS,""^"",4))"
^MAGD(2006.79,20,1,67,0)=" ; 4-ward ; 5-doc ; 6-treat spec ; 7-dx"
^MAGD(2006.79,20,1,68,0)=" S @VAV@(VANODE,4)=@VAV@($P(VAS,""^"",5)),@VAV@(VANODE,5)=@VAV@($P(VAS,""^"",7)),@VAV@(VANODE,6)=@VAV@($P(VAS,""^"",8)),@VAV@(VANODE,7)=@VAV@($P(VAS,""^"",9))"
^MAGD(2006.79,20,1,69,0)=" Q"
^MAGD(2006.79,20,1,70,0)=" ;"
^MAGD(2006.79,20,1,71,0)="LODGER ; -- get lodger data"
^MAGD(2006.79,20,1,72,0)=" S VAWD=$S($P(VAMV0,""^"",2)=4:$P(VAMV0,""^"",6),$D(^DGPM(+$P(VAMV0,""^"",14),0)):$P(^(0),""^"",6),1:"""")"
^MAGD(2006.79,20,1,73,0)=" S VAWD=$S($D(^DIC(42,+VAWD,0)):VAWD_""^""_$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,74,0)=" S VARM=$S($P(VAMV0,""^"",2)=4:$P(VAMV0,""^"",7),$D(^DGPM(+$P(VAMV0,""^"",14),0)):$P(^(0),""^"",7),1:"""")"
^MAGD(2006.79,20,1,75,0)=" S VARM=$S($D(^DG(405.4,+VARM,0)):VARM_""^""_$P(^(0),""^""),1:"""")"
^MAGD(2006.79,20,1,76,0)=" Q"
^MAGD(2006.79,21,0)="VADPT32^3050311.125837"
^MAGD(2006.79,21,1,0)="^2006.791^19^19"
^MAGD(2006.79,21,1,1,0)="VADPT32 ;ALB/MRL/MJK - PATIENT VARIABLES [IN5], CONT.; 12 DEC 1988"
^MAGD(2006.79,21,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
^MAGD(2006.79,21,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
^MAGD(2006.79,21,1,4,0)=" ;"
^MAGD(2006.79,21,1,5,0)="BLD ; build array of mvt in reverse order up one before E mvt"
^MAGD(2006.79,21,1,6,0)=" K ^UTILITY(""VADPTZ"",$J,DFN) S (VANN,VAQ,VAZ,VACC)=0"
^MAGD(2006.79,21,1,7,0)=" I ""^4^5^""[(""^""_$P(VAMV0,""^"",2)_""^"") D LODGER G BLDQ"
^MAGD(2006.79,21,1,8,0)=" F I=0:0 S VAZ=$O(^DGPM(""APMV"",DFN,VAX(""CA""),VAZ)),VAZ(1)=0 Q:VAQ!(VAZ'>0)  F I1=0:0 S VAZ(1)=$O(^DGPM(""APMV"",DFN,VAX(""CA""),VAZ,VAZ(1))) Q:VAQ!(VAZ(1)'>0)  S VACC=VACC+1 D BA"
^MAGD(2006.79,21,1,9,0)="BLDQ K VACC,VAQ,VAZ Q"
^MAGD(2006.79,21,1,10,0)=" ;"
^MAGD(2006.79,21,1,11,0)="BA ;Build Movement Array"
^MAGD(2006.79,21,1,12,0)=" I VANN,VACC=(VANN+2) S VAQ=1 Q"
^MAGD(2006.79,21,1,13,0)=" S:VAZ(1)=+E VANN=VACC S X=$S($D(^DGPM(+VAZ(1),0)):^(0),1:""""),^UTILITY(""VADPTZ"",$J,DFN,VACC)=VAZ(1)_""||""_X Q"
^MAGD(2006.79,21,1,14,0)=" ;"
^MAGD(2006.79,21,1,15,0)="LODGER ;"
^MAGD(2006.79,21,1,16,0)=" S VANN=1,X=^DGPM(E,0)"
^MAGD(2006.79,21,1,17,0)=" I $P(X,""^"",2)=5 S ^UTILITY(""VADPTZ"",$J,DFN,1)=E_""||""_X S:$D(^DGPM(+$P(X,""^"",14),0)) ^UTILITY(""VADPTZ"",$J,DFN,2)=+$P(X,""^"",14)_""||""_^(0)"
^MAGD(2006.79,21,1,18,0)=" I $P(X,""^"",2)=4 S:$D(^DGPM(+$P(X,""^"",17),0)) ^UTILITY(""VADPTZ"",$J,DFN,1)=+$P(X,""^"",17)_""||""_^(0),VANN=2 S ^UTILITY(""VADPTZ"",$J,DFN,VANN)=E_""||""_X"
^MAGD(2006.79,21,1,19,0)=" Q"
^MAGD(2006.79,22,0)="VADPT4^3050311.125837"
^MAGD(2006.79,22,1,0)="^2006.791^58^58"
^MAGD(2006.79,22,1,1,0)="VADPT4 ;ALB/MRL/MJK - PATIENT VARIABLES; 12 DEC 1988"
^MAGD(2006.79,22,1,2,0)=" ;;5.3;Registration;**343,342,528**;Aug 13, 1993"
^MAGD(2006.79,22,1,3,0)="7 ;Eligibility [ELIG]"
^MAGD(2006.79,22,1,4,0)=" F I=.15,.3,.31,.32,.36,.361,""INE"",""TYPE"",""VET"" S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"""")"
^MAGD(2006.79,22,1,5,0)=" S VAZ=$P(VAX(.36),""^"",1) S:$D(^DIC(8,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",1))=VAZ"
^MAGD(2006.79,22,1,6,0)=" S VAX=0 F I=0:0 S VAX=$O(^DPT(DFN,""E"",VAX)) Q:VAX'>0  S VAZ=VAX I $D(^DIC(8,+VAZ,0)),+@VAV@($P(VAS,""^""))'=VAZ S VAZ=VAZ_""^""_$P(^DIC(8,+VAZ,0),""^"") S @VAV@($P(VAS,""^"",1),VAX)=VAZ"
^MAGD(2006.79,22,1,7,0)=" S VAZ=$P(VAX(.32),""^"",3) S:$D(^DIC(21,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",2))=VAZ"
^MAGD(2006.79,22,1,8,0)=" S VAZ=$S($P(VAX(.3),""^"",1)=""Y"":1,1:0) S:VAZ VAZ=VAZ_""^""_$P(VAX(.3),""^"",2) S @VAV@($P(VAS,""^"",3))=VAZ"
^MAGD(2006.79,22,1,9,0)=" S @VAV@($P(VAS,""^"",4))=$S(VAX(""VET"")=""Y"":1,1:0),VAZ=$S(+$P(VAX(.15),""^"",2):0,1:1),@VAV@($P(VAS,""^"",5))=VAZ"
^MAGD(2006.79,22,1,10,0)=" I VAZ F I=1:1:6 S @VAV@($P(VAS,""^"",5),I)="""" G 71"
^MAGD(2006.79,22,1,11,0)=" S VAZ=$P(VAX(.15),""^"",2),Y=VAZ X ^DD(""DD"") S @VAV@($P(VAS,""^"",5),1)=VAZ_""^""_Y,VAZ=$P(VAX(""INE""),""^"",1) S:VAZ]"""" VAZ=VAZ_""^""_$P(""VAMC^REGIONAL OFFICE^RPC"",""^"",VAZ) S @VAV@($P(VAS,""^"",5),2)=VAZ"
^MAGD(2006.79,22,1,12,0)=" S @VAV@($P(VAS,""^"",5),3)=$P(VAX(""INE""),""^"",3),VAZ=$P(VAX(""INE""),""^"",4) S:$D(^DIC(5,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",5),4)=VAZ"
^MAGD(2006.79,22,1,13,0)=" S @VAV@($P(VAS,""^"",5),5)=$P(VAX(""INE""),""^"",6),@VAV@($P(VAS,""^"",5),6)=$P(VAX(.3),""^"",7)"
^MAGD(2006.79,22,1,14,0)="71 S VAZ=VAX(""TYPE"") S:$D(^DG(391,+VAZ,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",6))=VAZ"
^MAGD(2006.79,22,1,15,0)=" S @VAV@($P(VAS,""^"",7))=$P(VAX(.31),""^"",3),VAZ=$P(VAX(.361),""^"",1) S:VAZ]"""" VAZ=VAZ_""^""_$S(VAZ=""V"":""VERIFIED"",VAZ=""P"":""PENDING VERIFICATION"",VAZ=""R"":""PENDING RE-VERIFICATION"",1:"""") S @VAV@($P(VAS,""^"",8))=VAZ"
^MAGD(2006.79,22,1,16,0)=" I $D(^DPT(DFN,0)) S VAX=$P(^(0),""^"",14),VAX=$G(^DG(408.32,+VAX,0)) I VAX]"""" S @VAV@($P(VAS,""^"",9))=$P(VAX,""^"",2)_""^""_$P(VAX,""^"",1)"
^MAGD(2006.79,22,1,17,0)=" Q"
^MAGD(2006.79,22,1,18,0)=" ;"
^MAGD(2006.79,22,1,19,0)="8 ;Monetary Benefits [MB]"
^MAGD(2006.79,22,1,20,0)=" N DGTOTVA"
^MAGD(2006.79,22,1,21,0)=" S @VAV@($P(VAS,""^"",6))=0 ; SSI no longer supported"
^MAGD(2006.79,22,1,22,0)=" D ALL^DGMTU21(DFN,""V"",DT,""I"")"
^MAGD(2006.79,22,1,23,0)=" S VAX=$G(^DGMT(408.21,+$G(DGINC(""V"")),0)) F I=8,11,13 S @VAV@($S(I=8:$P(VAS,""^"",3),I=11:$P(VAS,""^"",5),1:$P(VAS,""^"",8)))=$S($P(VAX,""^"",I)'="""":""1^""_$P(VAX,""^"",I),1:0)"
^MAGD(2006.79,22,1,24,0)=" S VAX=$G(^DPT(DFN,.362))"
^MAGD(2006.79,22,1,25,0)=" S DGTOTVA=$P(VAX,U,20)"
^MAGD(2006.79,22,1,26,0)=" F I=12,13,14 S @VAV@($S(I=12:$P(VAS,""^"",1),(I=13):$P(VAS,""^"",2),1:$P(VAS,""^"",4)))=$S($P(VAX,""^"",I)=""Y"":1_U_DGTOTVA,1:0)"
^MAGD(2006.79,22,1,27,0)=" S I=17 S @VAV@($P(VAS,""^"",9))=$S($P(VAX,""^"",17)=""Y"":1_U_$P(VAX,U,6),1:0)"
^MAGD(2006.79,22,1,28,0)=" S VAX=$G(^DPT(DFN,.3)) S @VAV@($P(VAS,""^"",7))=$S($P(VAX,""^"",11)=""Y"":1_U_DGTOTVA,1:0)"
^MAGD(2006.79,22,1,29,0)=" K DGDEP,DGREL,DGINC,DGINR Q"
^MAGD(2006.79,22,1,30,0)=" ;"
^MAGD(2006.79,22,1,31,0)="9 ;Service information"
^MAGD(2006.79,22,1,32,0)=" F I=.32,.321,.52,.53 S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"""")"
^MAGD(2006.79,22,1,33,0)=" S VAX(""N"")=.321 F I=1,2,3 S VAX(3)=I,VAZ=$S($P(VAX(.321),""^"",I)=""Y"":1,1:0),@VAV@($P(VAS,""^"",VAX(3)))=VAZ I VAZ S VAX(1)=$S(I=1:""4^5"",I=2:""7^9^8"",1:11),VAX(4)=0 D 91"
^MAGD(2006.79,22,1,34,0)=" S VAX(""N"")=.52 F I=5,11 S VAX(3)=$S(I=5:4,1:5),VAX(1)=$S(I=5:""7^8"",1:""13^14""),VAZ=$S($P(VAX(.52),""^"",I)=""Y"":1,1:0),@VAV@($P(VAS,""^"",VAX(3)))=VAZ I VAZ S VAX(4)=0 D 91"
^MAGD(2006.79,22,1,35,0)=" S VAX(3)=10,VAX(1)=""15"",VAZ=$S($P(VAX(.52),U,15)]"""":1,1:0),@VAV@($P(VAS,U,VAX(3)))=VAZ I VAZ S VAX(4)=0 D 91"
^MAGD(2006.79,22,1,36,0)=" F I=6,7,8 S @VAV@($P(VAS,""^"",I))="""" F VAX(1)=1:1:5 S @VAV@($P(VAS,""^"",I),VAX(1))="""""
^MAGD(2006.79,22,1,37,0)=" S VAX(""N"")=.32,VAZ=$S($P(VAX(.32),""^"",5)]"""":1,1:0),@VAV@($P(VAS,""^"",6))=VAZ I VAZ,$P(VAX(.32),""^"",19)=""Y"" S VAZ=1,@VAV@($P(VAS,""^"",7))=VAZ I VAZ,$P(VAX(.32),""^"",20)=""Y"" S @VAV@($P(VAS,""^"",8))=1"
^MAGD(2006.79,22,1,38,0)=" F I=6,7,8 I @VAV@($P(VAS,""^"",I)) S VAX(3)=I,VAX(1)=$S(I=6:""6^7"",I=7:""11^12"",1:""16^17""),VAX(4)=3 D 91"
^MAGD(2006.79,22,1,39,0)=" S VAX(""N"")=.53,VAX(3)=9,VAX(1)=""2^3"",VAZ=$S($P(VAX(.53),U)=""Y"":1,$P(VAX(.53),U)=""N"":1,1:0),@VAV@($P(VAS,U,VAX(3)))=$S($P(VAX(.53),U)=""Y"":1,$P(VAX(.53),U)=""N"":0,1:"""") I VAZ S VAX(4)=0 D 93"
^MAGD(2006.79,22,1,40,0)=" Q"
^MAGD(2006.79,22,1,41,0)=" ;"
^MAGD(2006.79,22,1,42,0)="91 F VAX(2)=1:1 S VAX(4)=VAX(4)+1,X=+$P(VAX(1),""^"",VAX(2)) Q:'X  S X=$P(VAX(VAX(""N"")),""^"",X),VAZ=X,Y=VAZ X:Y]"""" ^DD(""DD"") S @VAV@($P(VAS,""^"",VAX(3)),VAX(4))=$S(VAZ]"""":VAZ_""^""_Y,1:"""")"
^MAGD(2006.79,22,1,43,0)=" Q:VAX(3)=1!(VAX(3)=9)!(VAX(3)=10)"
^MAGD(2006.79,22,1,44,0)=" I VAX(3)=2 S @VAV@($P(VAS,""^"",2),4)=$P(VAX(.321),""^"",10) S (X,VAZ)=$P(VAX(.321),""^"",13) S:X]"""" VAZ=VAZ_""^""_$S(X=""K"":""KOREAN DMZ"",1:""VIETNAM"") S @VAV@($P(VAS,""^"",2),5)=VAZ Q"
^MAGD(2006.79,22,1,45,0)=" I VAX(3)<4 S X=$P(VAX(.321),""^"",12),VAZ=X S:X]"""" VAZ=VAZ_""^""_$S(X=""T"":""NUCLEAR TESTING"",X=""N"":""NAGASAKI/HIROSHIMA"",1:""BOTH"") S @VAV@($P(VAS,""^"",3),2)=VAZ Q"
^MAGD(2006.79,22,1,46,0)=" I VAX(3)<6 S X=$P(VAX(VAX(""N"")),""^"",$S(VAX(3)=4:6,1:12)),VAZ=X S:$D(^DIC(22,+X,0)) VAZ=VAZ_""^""_$P(^(0),""^"",1) S @VAV@($P(VAS,""^"",VAX(3)),3)=VAZ Q"
^MAGD(2006.79,22,1,47,0)=" S X=$S(VAX(3)=6:5,VAX(3)=7:10,1:15),VAX(2)=0 F VAX(5)=X,X+3,X-1 S VAX(2)=VAX(2)+1,VAZ=$P(VAX(VAX(""N"")),""^"",VAX(5)),@VAV@($P(VAS,""^"",VAX(3)),VAX(2))=VAZ I ""^4^5^9^10^14^15^""[(""^""_VAX(5)_""^""),+VAZ D 92"
^MAGD(2006.79,22,1,48,0)=" Q"
^MAGD(2006.79,22,1,49,0)="92 S VAX(6)=""^DIC(""_$S('(VAX(5)#5):23,1:25)_"",""_+VAZ_"",0)"" I $D(@(VAX(6))) S VAZ=$P(^(0),""^"",1),@VAV@($P(VAS,""^"",VAX(3)),VAX(2))=@VAV@($P(VAS,""^"",VAX(3)),VAX(2))_""^""_VAZ"
^MAGD(2006.79,22,1,50,0)=" Q"
^MAGD(2006.79,22,1,51,0)="93 ;"
^MAGD(2006.79,22,1,52,0)=" NEW VAFILE,VAIENS,VAFLDS,VAARR,VAI"
^MAGD(2006.79,22,1,53,0)=" S VAFILE=2,VAIENS=DFN_"","",VAFLDS="".532;.533"""
^MAGD(2006.79,22,1,54,0)=" D GETS^DIQ(VAFILE,VAIENS,VAFLDS,""IEN"",""VAARR"")"
^MAGD(2006.79,22,1,55,0)=" F VAI=1:1 S VAFLDS(VAI)=$P(VAFLDS,"";"",VAI) Q:VAFLDS(VAI)=""""  D"
^MAGD(2006.79,22,1,56,0)=" . I '$D(VAARR(VAFILE,VAIENS,VAFLDS(VAI),""I"")),'$D(VAARR(VAFILE,VAIENS,VAFLDS(VAI),""E"")) S @VAV@($P(VAS,""^"",VAX(3)),VAI)="""""
^MAGD(2006.79,22,1,57,0)=" . E  S @VAV@($P(VAS,U,VAX(3)),VAI)=$G(VAARR(VAFILE,VAIENS,VAFLDS(VAI),""I""))_""^""_$G(VAARR(VAFILE,VAIENS,VAFLDS(VAI),""E""))"
^MAGD(2006.79,22,1,58,0)=" Q"
^MAGD(2006.79,23,0)="VADPT5^3050311.125837"
^MAGD(2006.79,23,1,0)="^2006.791^103^103"
^MAGD(2006.79,23,1,1,0)="VADPT5 ;ALB/MRL/MJK - PATIENT VARIABLES [REG]; 14 DEC 1988 ; 8/6/04 7:42am"
^MAGD(2006.79,23,1,2,0)=" ;;5.3;Registration;**54,63,242,584**;Aug 13, 1993"
^MAGD(2006.79,23,1,3,0)="10 ;Registration/Disposition [REG]"
^MAGD(2006.79,23,1,4,0)=" N VARPSV"
^MAGD(2006.79,23,1,5,0)=" S VARPSV(""C"")=$S('$G(VARP(""C"")):999999999,1:+VARP(""C""))"
^MAGD(2006.79,23,1,6,0)=" S VARPSV(""F"")=9999999-$S($G(VARP(""F""))?7N.E:VARP(""F""),1:0)"
^MAGD(2006.79,23,1,7,0)=" S VARPSV(""T"")=$S($G(VARP(""T""))?7N.E:VARP(""T""),1:7777777) I '$P(VARPSV(""T""),""."",2) S $P(VARPSV(""T""),""."",2)=999999"
^MAGD(2006.79,23,1,8,0)=" S VARPSV(""T"")=9999999-VARPSV(""T"")"
^MAGD(2006.79,23,1,9,0)=" S VAX=VARPSV(""T""),VAX(1)=0"
^MAGD(2006.79,23,1,10,0)=" I '$D(^DPT(DFN,""DIS"")) Q"
^MAGD(2006.79,23,1,11,0)=" F I=0:0 S VAX=$O(^DPT(DFN,""DIS"",VAX)) Q:VAX=""""!(VAX>VARPSV(""F""))!(VAX(1)+1>VARPSV(""C""))  S VAX(2)=$G(^DPT(DFN,""DIS"",VAX,0)),VAX(1)=VAX(1)+1 D 101:+VAX(2)>0"
^MAGD(2006.79,23,1,12,0)=" Q"
^MAGD(2006.79,23,1,13,0)="101 S (VAX(""I""),VAX(""E""))="""",VAX(3)=0 F I=1,2,3,4,5,6,7,9 S VAX(3)=VAX(3)+1,$P(VAX(""I""),""^"",VAX(3))=$P(VAX(2),""^"",I) D 102"
^MAGD(2006.79,23,1,14,0)=" S @VAV@(VAX(1),""I"")=VAX(""I""),@VAV@(VAX(1),""E"")=VAX(""E"") Q"
^MAGD(2006.79,23,1,15,0)="102 I ""^1^6^""[(""^""_VAX(3)_""^"") S Y=$P(VAX(""I""),""^"",VAX(3)) I Y]"""" X ^DD(""DD"") S $P(VAX(""E""),""^"",VAX(3))=Y Q"
^MAGD(2006.79,23,1,16,0)=" S X(1)=$S($D(^DD(2.101,$S(I<9:(I-1),1:I),0)):$P(^(0),""^"",3),1:"""") I ""^2^3^""[(""^""_VAX(3)_""^""),$P(VAX(""I""),""^"",VAX(3))]"""",X(1)]"""" S $P(VAX(""E""),""^"",VAX(3))=$P($P(X(1),$P(VAX(""I""),""^"",VAX(3))_"":"",2),"";"",1) Q"
^MAGD(2006.79,23,1,17,0)=" I ""^4^5^7^8^""[(""^""_VAX(3)_""^""),$P(VAX(""I""),""^"",VAX(3))]"""",X(1)]"""" S X(1)=""^""_X(1)_$P(VAX(""I""),""^"",VAX(3))_"",0)"" I $D(@(X(1))) S $P(VAX(""E""),""^"",VAX(3))=$P(^(0),""^"",1)"
^MAGD(2006.79,23,1,18,0)=" Q"
^MAGD(2006.79,23,1,19,0)=" ;"
^MAGD(2006.79,23,1,20,0)="11 ;Clinic Enrollments [SDE]"
^MAGD(2006.79,23,1,21,0)=" S (VAX,VAX(1))=0 F I=0:0 S VAX=$O(^DPT(DFN,""DE"",VAX)) Q:VAX'>0  S VAZ=$S($D(^DPT(DFN,""DE"",VAX,0)):^(0),1:"""") I +VAZ,$P(VAZ,""^"",2)'=""I"" S VAX(3)=0 D 111"
^MAGD(2006.79,23,1,22,0)=" Q"
^MAGD(2006.79,23,1,23,0)="111 S VAX(4)=0 F I1=0:0 S VAX(4)=$O(^DPT(DFN,""DE"",VAX,1,VAX(4))) Q:VAX(4)'>0!(VAX(3))  S VAZ(1)=$S($D(^DPT(DFN,""DE"",VAX,1,VAX(4),0)):^(0),1:"""") I +VAZ(1),$P(VAZ(1),""^"",3)']"""" S VAX(3)=VAZ(1)"
^MAGD(2006.79,23,1,24,0)=" Q:'VAX(3)  S (VAX(""I""),VAX(""E""))="""",Y=+VAX(3),$P(VAX(""I""),""^"",2)=Y X ^DD(""DD"") S $P(VAX(""E""),""^"",2)=Y"
^MAGD(2006.79,23,1,25,0)=" S $P(VAX(""I""),""^"",3)=$P(VAX(3),""^"",2) I $P(VAX(""I""),""^"",3)]"""" S $P(VAX(""E""),""^"",3)=$S($P(VAX(""I""),""^"",3)=""O"":""OPT"",$P(VAX(""I""),""^"",3)=""A"":""AC"",1:"""")"
^MAGD(2006.79,23,1,26,0)=" S $P(VAX(""I""),""^"",1)=+VAZ,$P(VAX(""E""),""^"",1)=$S($D(^SC(+VAZ,0)):$P(^(0),""^"",1),1:""""),VAX(1)=VAX(1)+1,@VAV@(VAX(1),""I"")=VAX(""I""),@VAV@(VAX(1),""E"")=VAX(""E"") Q"
^MAGD(2006.79,23,1,27,0)=" ;"
^MAGD(2006.79,23,1,28,0)="12 ;Appointments [SDA]"
^MAGD(2006.79,23,1,29,0)=" N VASDSV,SDCNT,SDARRAY"
^MAGD(2006.79,23,1,30,0)=" D NOW^%DTC"
^MAGD(2006.79,23,1,31,0)=" S VASDSV(""F"")=$S($G(VASD(""F""))?7N.E:VASD(""F""),1:%)"
^MAGD(2006.79,23,1,32,0)=" S VASDSV(""T"")=$S(+$G(VASD(""T"")):+VASD(""T""),1:9999999) I '$P(VASDSV(""T""),""."",2) S $P(VASDSV(""T""),""."",2)=999999"
^MAGD(2006.79,23,1,33,0)=" S VASDSV(""W"")=$S('$G(VASD(""W"")):12,1:VASD(""W""))"
^MAGD(2006.79,23,1,34,0)=" S VAZ(2)=$S($D(VASD(""N"")):VASD(""N""),1:9999)"
^MAGD(2006.79,23,1,35,0)=" ;Set STATUS Codes (VistA;RSA)"
^MAGD(2006.79,23,1,36,0)=" S VAZ="";R^I;I^N;NS^NA;NSR^C;CC^CA;CCR^PC;CP^PCA;CPR^NT;NT^"",VAZ(1)="""""
^MAGD(2006.79,23,1,37,0)=" ;Extract User Required STATUS Codes in RSA format"
^MAGD(2006.79,23,1,38,0)=" F I=1:1 S I1=+$E(VASDSV(""W""),I) Q:'I1  D"
^MAGD(2006.79,23,1,39,0)=" .S VAZ(1)=VAZ(1)_$P($P(VAZ,""^"",I1),"";"",2)_"";"""
^MAGD(2006.79,23,1,40,0)=" ;Create parameter list for the extrinsic call to the Appointment API"
^MAGD(2006.79,23,1,41,0)=" ;Note: Appointment API can only accept a maximum of 3 fields "
^MAGD(2006.79,23,1,42,0)=" ;               to filter on."
^MAGD(2006.79,23,1,43,0)=" ; 1 : ""FROM;TO"" Appointment Date Range to Search"
^MAGD(2006.79,23,1,44,0)=" ; 2 : Clinic IEN or Array of Clinic IENs if defined (Pass the Root)"
^MAGD(2006.79,23,1,45,0)=" ; 3 : Requested STATUS Codes (Passed if VASD(""C"") is not defined.)"
^MAGD(2006.79,23,1,46,0)=" ; 4 : Patient IEN"
^MAGD(2006.79,23,1,47,0)=" S SDARRAY="""",SDARRAY(1)=VASDSV(""F"")_"";""_VASDSV(""T"")"
^MAGD(2006.79,23,1,48,0)=" I $O(VASD(""C"",0))>0 S SDARRAY(2)=""VASD(""""C"""","""
^MAGD(2006.79,23,1,49,0)=" E  S SDARRAY(3)=VAZ(1)"
^MAGD(2006.79,23,1,50,0)=" S SDARRAY(4)=DFN"
^MAGD(2006.79,23,1,51,0)=" ;Set Fields for API to Return"
^MAGD(2006.79,23,1,52,0)=" ;  1 : Appointment Date/Time"
^MAGD(2006.79,23,1,53,0)=" ;  2 : Clinic"
^MAGD(2006.79,23,1,54,0)=" ;  3 : Appointment Status"
^MAGD(2006.79,23,1,55,0)=" ; 10 : Appointment Type"
^MAGD(2006.79,23,1,56,0)=" S SDARRAY(""FLDS"")=""1;2;3;10"""
^MAGD(2006.79,23,1,57,0)=" ;Remove Clinic IEN from Global Reference"
^MAGD(2006.79,23,1,58,0)=" S SDARRAY(""SORT"")=""P"""
^MAGD(2006.79,23,1,59,0)=" ;Call Appointment API (Pass Array by reference)"
^MAGD(2006.79,23,1,60,0)=" S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)"
^MAGD(2006.79,23,1,61,0)=" S VAX="""",VAX(1)=0"
^MAGD(2006.79,23,1,62,0)=" ;If error returned, determine error and set VAERR appropriately"
^MAGD(2006.79,23,1,63,0)=" ; 1 : For any error other than 101"
^MAGD(2006.79,23,1,64,0)=" ; 2 : If error is 101 : Database is unavailable  "
^MAGD(2006.79,23,1,65,0)=" I SDCNT<0 S VAX=$O(^TMP($J,""SDAMA301"",VAX)) S VAERR=$S(VAX=101:2,1:1) K ^TMP($J,""SDAMA301"") Q"
^MAGD(2006.79,23,1,66,0)=" D 122:SDCNT>0"
^MAGD(2006.79,23,1,67,0)=" Q"
^MAGD(2006.79,23,1,68,0)="121 S VAX(5)=1 I VASDSV(""W"")'[1,$P(VAZ,""^"",2)']"""" S VAX(5)=0 Q"
^MAGD(2006.79,23,1,69,0)=" I VASDSV(""C""),'$D(VASD(""C"",+VAZ)) S VAX(5)=0 Q"
^MAGD(2006.79,23,1,70,0)=" S (VAX(""I""),VAX(""E""))="""",VAX(2)=1,$P(VAX(""I""),""^"",1)=+VAX F I1=1,2,16 S VAX(2)=VAX(2)+1,$P(VAX(""I""),""^"",VAX(2))=$P(VAZ,""^"",I1)"
^MAGD(2006.79,23,1,71,0)=" Q"
^MAGD(2006.79,23,1,72,0)="122 ;Build Internal/External Output Globals"
^MAGD(2006.79,23,1,73,0)=" ;"
^MAGD(2006.79,23,1,74,0)=" N SDCIEN,SDDTM,SDNODE"
^MAGD(2006.79,23,1,75,0)=" S (SDCIEN,SDDTM)="""""
^MAGD(2006.79,23,1,76,0)=" ;Redefine VAZ (STATUS Codes(RSA;VistA))"
^MAGD(2006.79,23,1,77,0)=" S VAZ=""R;^I;I^NS;N^NSR;NA^CC;C^CCR;CA^CP;PC^CPR;PCA^NT;NT^"""
^MAGD(2006.79,23,1,78,0)=" S SDDTM="""""
^MAGD(2006.79,23,1,79,0)=" ;Loop through appointments and convert for output"
^MAGD(2006.79,23,1,80,0)=" F  S SDDTM=$O(^TMP($J,""SDAMA301"",DFN,SDDTM)) Q:'SDDTM  D "
^MAGD(2006.79,23,1,81,0)=" .;Get Appointment Information and clear VAX(""I"") & VAX(""E"")"
^MAGD(2006.79,23,1,82,0)=" .S SDNODE=^(SDDTM),(VAX(""I""),VAX(""E""))="""""
^MAGD(2006.79,23,1,83,0)=" .;If Clinics were passed to appointment API,"
^MAGD(2006.79,23,1,84,0)=" .;     Filter on Appointment Status Codes"
^MAGD(2006.79,23,1,85,0)=" .I $O(VASD(""C"",0))>0,(VAZ(1)'[($P($P(SDNODE,""^"",3),"";"")_"";"")) Q"
^MAGD(2006.79,23,1,86,0)=" .;Extract and format Appointment Date/Time"
^MAGD(2006.79,23,1,87,0)=" .S Y=$P(SDNODE,""^"",1)"
^MAGD(2006.79,23,1,88,0)=" .S $P(VAX(""I""),""^"",1)=Y"
^MAGD(2006.79,23,1,89,0)=" .X ^DD(""DD"") S $P(VAX(""E""),""^"",1)=Y"
^MAGD(2006.79,23,1,90,0)=" .;Extract and format Clinic Information"
^MAGD(2006.79,23,1,91,0)=" .S $P(VAX(""I""),""^"",2)=$P($P(SDNODE,""^"",2),"";"",1)"
^MAGD(2006.79,23,1,92,0)=" .S $P(VAX(""E""),""^"",2)=$P($P(SDNODE,""^"",2),"";"",2)"
^MAGD(2006.79,23,1,93,0)=" .;Extract and format Appointment Type"
^MAGD(2006.79,23,1,94,0)=" .S $P(VAX(""I""),""^"",4)=$P($P(SDNODE,""^"",10),"";"",1)"
^MAGD(2006.79,23,1,95,0)=" .S $P(VAX(""E""),""^"",4)=$P($P(SDNODE,""^"",10),"";"",2)"
^MAGD(2006.79,23,1,96,0)=" .;Extract and format Appointment Status"
^MAGD(2006.79,23,1,97,0)=" .S Y=$P($P(VAZ,$P($P(SDNODE,""^"",3),"";"")_"";"",2),""^""),$P(VAX(""I""),""^"",3)=Y"
^MAGD(2006.79,23,1,98,0)=" .I Y]"""" S X=$S($D(^DD(2.98,3,0)):$P(^(0),""^"",3),1:""""),$P(VAX(""E""),""^"",3)=$P($P(X,Y_"":"",2),"";"",1)"
^MAGD(2006.79,23,1,99,0)=" .S VAX(1)=VAX(1)+1"
^MAGD(2006.79,23,1,100,0)=" .;Store information in global"
^MAGD(2006.79,23,1,101,0)=" .S @VAV@(VAX(1),""I"")=VAX(""I""),@VAV@(VAX(1),""E"")=VAX(""E"")"
^MAGD(2006.79,23,1,102,0)=" K ^TMP($J,""SDAMA301"")"
^MAGD(2006.79,23,1,103,0)=" Q"
^MAGD(2006.79,24,0)="VADPT6^3050311.125837"
^MAGD(2006.79,24,1,0)="^2006.791^73^73"
^MAGD(2006.79,24,1,1,0)="VADPT6 ;ALB/MJK - PATIENT ID VARIABLES ; 12 AUG 89 @1200"
^MAGD(2006.79,24,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
^MAGD(2006.79,24,1,3,0)=" ;"
^MAGD(2006.79,24,1,4,0)="PID ;"
^MAGD(2006.79,24,1,5,0)="13 ; -- Returns the patient id variables for DFN patient"
^MAGD(2006.79,24,1,6,0)=" ;    usually VA(""PID"")=123-45-6789 and VA(""BID"")=""6789"""
^MAGD(2006.79,24,1,7,0)=" ;    for VA patients."
^MAGD(2006.79,24,1,8,0)=" ;"
^MAGD(2006.79,24,1,9,0)=" ; -- Returns patient id variables as defined for the requested"
^MAGD(2006.79,24,1,10,0)=" ;    patient eligibility for DFN patient.  The variable VAPTYP should"
^MAGD(2006.79,24,1,11,0)=" ;    contain the internal number of the desired patient eligibility."
^MAGD(2006.79,24,1,12,0)=" ;"
^MAGD(2006.79,24,1,13,0)=" ;    If the VAPTYP eligibility  does not exist, then the standard"
^MAGD(2006.79,24,1,14,0)=" ;    values, as defined above, will be passed back."
^MAGD(2006.79,24,1,15,0)=" ;"
^MAGD(2006.79,24,1,16,0)=" N X,L,B K VAERR S (L,B)="""""
^MAGD(2006.79,24,1,17,0)=" ; L = long id ; B = brief or short id"
^MAGD(2006.79,24,1,18,0)=" S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(+DFN,0)):1,1:0) I VAERR G PIDQ"
^MAGD(2006.79,24,1,19,0)=" I $D(VAPTYP),$D(^DPT(DFN,""E"",+VAPTYP,0)) S X=^(0),L=$P(X,""^"",3),B=$P(X,""^"",4)"
^MAGD(2006.79,24,1,20,0)=" ; -- set default id's"
^MAGD(2006.79,24,1,21,0)=" I L="""",$D(^DPT(DFN,.36)) S X=^(.36) I +X S L=$P(X,""^"",3),B=$P(X,""^"",4)"
^MAGD(2006.79,24,1,22,0)=" I L="""" S X=$P(^DPT(DFN,0),""^"",9) I X]"""" S L=$E(X,1,3)_""-""_$E(X,4,5)_""-""_$E(X,6,10),B=$E(X,6,10)"
^MAGD(2006.79,24,1,23,0)=" ;"
^MAGD(2006.79,24,1,24,0)="PIDQ S VA(""PID"")=L,VA(""BID"")=B Q"
^MAGD(2006.79,24,1,25,0)=" ;"
^MAGD(2006.79,24,1,26,0)="SET ;-- execute id format specific long id, short id and x-ref set logic"
^MAGD(2006.79,24,1,27,0)=" ;   input: VADFN == DFN"
^MAGD(2006.79,24,1,28,0)=" ;"
^MAGD(2006.79,24,1,29,0)=" Q:'$D(^DPT(VADFN,""E"",0))"
^MAGD(2006.79,24,1,30,0)=" N X,DA S DA(1)=VADFN"
^MAGD(2006.79,24,1,31,0)=" F DA=0:0 S DA=$O(^DPT(DA(1),""E"",DA)) Q:'DA  I $D(^(DA,0)) D SET1"
^MAGD(2006.79,24,1,32,0)=" K X,DA"
^MAGD(2006.79,24,1,33,0)=" Q"
^MAGD(2006.79,24,1,34,0)="SET1 ;"
^MAGD(2006.79,24,1,35,0)=" D CHK G SET1Q:'VAFMT"
^MAGD(2006.79,24,1,36,0)=" ; -- calc/store long id"
^MAGD(2006.79,24,1,37,0)=" S X="""""
^MAGD(2006.79,24,1,38,0)=" I $D(^DIC(8.2,VAFMT,""LONG"")) X ^(""LONG"") S $P(^DPT(DA(1),""E"",DA,0),U,3)=X"
^MAGD(2006.79,24,1,39,0)=" ; -- long id x-refs (set logic)"
^MAGD(2006.79,24,1,40,0)=" S VAX=X G SET1Q:X="""""
^MAGD(2006.79,24,1,41,0)=" F VAIX=0:0 S VAIX=$O(^DD(2.0361,.03,1,VAIX)) Q:'VAIX  X ^(VAIX,1) S X=VAX"
^MAGD(2006.79,24,1,42,0)=" ; -- short id x-refs (set logic)"
^MAGD(2006.79,24,1,43,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,4) G SET1Q:X="""""
^MAGD(2006.79,24,1,44,0)=" F VAIX=0:0 S VAIX=$O(^DD(2.0361,.04,1,VAIX)) Q:'VAIX  X ^(VAIX,1) S X=VAX"
^MAGD(2006.79,24,1,45,0)="SET1Q K VAIX,VAX,X,VAFMT"
^MAGD(2006.79,24,1,46,0)=" Q"
^MAGD(2006.79,24,1,47,0)=" ;"
^MAGD(2006.79,24,1,48,0)="KILL ; -- execute id format specific x-ref kill logic"
^MAGD(2006.79,24,1,49,0)=" ;    input: VADFN ==> DFN"
^MAGD(2006.79,24,1,50,0)=" ;"
^MAGD(2006.79,24,1,51,0)=" Q:'$D(^DPT(VADFN,""E"",0))"
^MAGD(2006.79,24,1,52,0)=" N X,DA S DA(1)=VADFN"
^MAGD(2006.79,24,1,53,0)=" F DA=0:0 S DA=$O(^DPT(DA(1),""E"",DA)) Q:'DA  I $D(^(DA,0)) D KILL1"
^MAGD(2006.79,24,1,54,0)=" K X,DA"
^MAGD(2006.79,24,1,55,0)=" Q"
^MAGD(2006.79,24,1,56,0)=" ;"
^MAGD(2006.79,24,1,57,0)="KILL1 ;"
^MAGD(2006.79,24,1,58,0)=" D CHK G KILL1Q:'VAFMT"
^MAGD(2006.79,24,1,59,0)=" ; -- short id x-ref (kill logic)"
^MAGD(2006.79,24,1,60,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,4) G KILL2:X="""""
^MAGD(2006.79,24,1,61,0)=" F VAIX=0:0 S VAIX=$O(^DD(2.0361,.04,1,VAIX)) Q:'VAIX  X ^(VAIX,2) S X=VAX"
^MAGD(2006.79,24,1,62,0)=" S $P(^DPT(DA(1),""E"",DA,0),U,4)="""""
^MAGD(2006.79,24,1,63,0)="KILL2 ; -- long id (kill logic)"
^MAGD(2006.79,24,1,64,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,3) G KILL1Q:X="""""
^MAGD(2006.79,24,1,65,0)=" F VAIX=0:0 S VAIX=$O(^DD(2.0361,.03,1,VAIX)) Q:'VAIX  X ^(VAIX,2) S X=VAX"
^MAGD(2006.79,24,1,66,0)=" S $P(^DPT(DA(1),""E"",DA,0),U,3)="""""
^MAGD(2006.79,24,1,67,0)="KILL1Q K VAX,VAIX,VAFMT"
^MAGD(2006.79,24,1,68,0)=" Q"
^MAGD(2006.79,24,1,69,0)=" ;"
^MAGD(2006.79,24,1,70,0)="CHK ; -- ok to proceed ; fmt defined"
^MAGD(2006.79,24,1,71,0)=" S VAFMT=0"
^MAGD(2006.79,24,1,72,0)=" I $D(^DIC(8,DA,0)) S VAFMT=+$P(^(0),U,10),VAFMT=$S($D(^DIC(8.2,VAFMT,0)):VAFMT,1:0)"
^MAGD(2006.79,24,1,73,0)=" Q"
^MAGD(2006.79,25,0)="VADPT60^3050311.125837"
^MAGD(2006.79,25,1,0)="^2006.791^100^100"
^MAGD(2006.79,25,1,1,0)="VADPT60 ;ALB/MJK - Patient ID Utilities; 12 AUG 89 @1200"
^MAGD(2006.79,25,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
^MAGD(2006.79,25,1,3,0)=" ;"
^MAGD(2006.79,25,1,4,0)="EN D DT^DICRW S X=""VADPT60"",DIK=""^DOPT(""""""_X_"""""","""
^MAGD(2006.79,25,1,5,0)=" G:$D(^DOPT(X,7)) A S ^DOPT(X,0)=""Patient ID Utilities^1N^"""
^MAGD(2006.79,25,1,6,0)=" F I=1:1 S Y=$T(@I) Q:Y=""""  S ^DOPT(X,I,0)=$P(Y,"";"",3,99)"
^MAGD(2006.79,25,1,7,0)=" D IXALL^DIK"
^MAGD(2006.79,25,1,8,0)="A ;"
^MAGD(2006.79,25,1,9,0)=" W !! S DIC=""^DOPT(""""VADPT60"""","",DIC(0)=""IQEAM"" D ^DIC Q:Y<0  D @+Y G A"
^MAGD(2006.79,25,1,10,0)=" ;"
^MAGD(2006.79,25,1,11,0)="1 ;;ID Format Enter/Edit"
^MAGD(2006.79,25,1,12,0)=" G 1^VADPT61"
^MAGD(2006.79,25,1,13,0)=" ;"
^MAGD(2006.79,25,1,14,0)="2 ;;Eligibility Code Enter/Edit"
^MAGD(2006.79,25,1,15,0)=" G 2^VADPT61"
^MAGD(2006.79,25,1,16,0)=" ;"
^MAGD(2006.79,25,1,17,0)="3 ;;Specific ID Format Reset (All Patients)"
^MAGD(2006.79,25,1,18,0)=" W ! S DIC=""^DIC(8.2,"",DIC(0)=""AEMQZ"" D ^DIC K DIC G Q3:+Y<1 S VAFMT=+Y"
^MAGD(2006.79,25,1,19,0)=" S X=Y(0) D WARN^VADPT61"
^MAGD(2006.79,25,1,20,0)="31 W !!,""Are you sure"" S %=2 D YN^DICN"
^MAGD(2006.79,25,1,21,0)=" I '% W !?5,""Answer 'YES' if you wish to reset id's for all patients with"",!?5,""this format."" G 31"
^MAGD(2006.79,25,1,22,0)=" G 3:%'=1"
^MAGD(2006.79,25,1,23,0)=" S VAOPT=3 D TASK^VADPT61 G Q3"
^MAGD(2006.79,25,1,24,0)="QUE3 ; -- determine which elig use format"
^MAGD(2006.79,25,1,25,0)=" D BEG^VADPT61"
^MAGD(2006.79,25,1,26,0)=" K VAELG F VAELG=0:0 S VAELG=$O(^DIC(8,""AF"",VAFMT,VAELG)) Q:'VAELG  S VAELG(VAELG)="""""
^MAGD(2006.79,25,1,27,0)=" ; -- find pt's and reset"
^MAGD(2006.79,25,1,28,0)=" F DFN=0:0 S DFN=$O(^DPT(DFN)) Q:'DFN  F VAELG=0:0 S VAELG=$O(^DPT(DFN,""E"",VAELG)) Q:'VAELG  I $D(VAELG(VAELG)),$D(^(VAELG,0)) D IX"
^MAGD(2006.79,25,1,29,0)=" D END^VADPT61"
^MAGD(2006.79,25,1,30,0)="Q3 K DFN,VAELG,VAFMT Q"
^MAGD(2006.79,25,1,31,0)=" ;"
^MAGD(2006.79,25,1,32,0)="4 ;;Primary Eligibility ID Reset (All Patients)"
^MAGD(2006.79,25,1,33,0)=" W !!,""Are you sure"" S %=2 D YN^DICN"
^MAGD(2006.79,25,1,34,0)=" I '% W !?5,""Answer 'YES' if you wish to set or reset the patient id for"",!?5,""the id format associated with EACH patient's primary eligibility."" G 4"
^MAGD(2006.79,25,1,35,0)=" G Q4:%'=1"
^MAGD(2006.79,25,1,36,0)="41 S VAOPT=4 D TASK^VADPT61 G Q4"
^MAGD(2006.79,25,1,37,0)="QUE4 K VALL D BEG^VADPT61,ALL,END^VADPT61"
^MAGD(2006.79,25,1,38,0)="Q4 Q"
^MAGD(2006.79,25,1,39,0)=" ;"
^MAGD(2006.79,25,1,40,0)="5 ;;Specific Eligibility ID Reset (All Patients)"
^MAGD(2006.79,25,1,41,0)=" W ! S DIC=""^DIC(8,"",DIC(0)=""AEMQZ"" D ^DIC K DIC G Q5:+Y<1 S VAELG=+Y"
^MAGD(2006.79,25,1,42,0)=" I '$D(^DIC(8.2,+$P(Y(0),U,10),0)) W !!?5,*7,""No id format specified for this eligibility."" G Q5"
^MAGD(2006.79,25,1,43,0)=" S X=^(0) D WARN^VADPT61"
^MAGD(2006.79,25,1,44,0)="51 W !!,""Are you sure"" S %=2 D YN^DICN"
^MAGD(2006.79,25,1,45,0)=" I '% W !?5,""Answer 'YES' if you wish to reset id's for all patients with"",!?5,""this ELIGIBILITY."" G 51"
^MAGD(2006.79,25,1,46,0)=" G 5:%'=1"
^MAGD(2006.79,25,1,47,0)=" S VAOPT=5 D TASK^VADPT61 G Q5"
^MAGD(2006.79,25,1,48,0)="QUE5 D BEG^VADPT61"
^MAGD(2006.79,25,1,49,0)=" F DFN=0:0 S DFN=$O(^DPT(DFN)) Q:'DFN  I $D(^DPT(DFN,""E"",VAELG,0)) D IX"
^MAGD(2006.79,25,1,50,0)=" D END^VADPT61"
^MAGD(2006.79,25,1,51,0)="Q5 K VAELG,DFN Q"
^MAGD(2006.79,25,1,52,0)=" ;"
^MAGD(2006.79,25,1,53,0)="6 ;;Reset ALL ID's for a Patient"
^MAGD(2006.79,25,1,54,0)=" W ! S DIC=""^DPT("",DIC(0)=""AEMQ"" D ^DIC K DIC G Q6:+Y<1 S DFN=+Y"
^MAGD(2006.79,25,1,55,0)="61 W !!,""Are you sure"" S %=2 D YN^DICN"
^MAGD(2006.79,25,1,56,0)=" I '% W !?5,""Answer 'YES' if you want to reset all the id's associated"",!?5,""with this patient."",!!?5,""If the id format requires user input, you will be asked to enter the id."" G 61"
^MAGD(2006.79,25,1,57,0)=" G 6:%'=1"
^MAGD(2006.79,25,1,58,0)="PAT ; -- entry point if DFN is defined"
^MAGD(2006.79,25,1,59,0)=" F VAELG=0:0 S VAELG=$O(^DPT(DFN,""E"",VAELG)) Q:'VAELG  I $D(^(VAELG,0)),$D(^DIC(8,VAELG,0)) W:'$D(VABATCH) !?5,""..."",$P(^(0),U) D IX I '$D(VABATCH) D ASK^VADPT61 W ?40,$P(^DPT(DFN,""E"",VAELG,0),U,3)_"" / ""_$P(^(0),U,4)"
^MAGD(2006.79,25,1,60,0)="Q6 K DFN,VAELG"
^MAGD(2006.79,25,1,61,0)=" Q"
^MAGD(2006.79,25,1,62,0)=" ;"
^MAGD(2006.79,25,1,63,0)="7 ;;Reset ALL ID's for ALL Patients"
^MAGD(2006.79,25,1,64,0)=" W !!,""Are you sure"" S %=2 D YN^DICN"
^MAGD(2006.79,25,1,65,0)=" I '% W !?5,""Answer 'YES' if you want to reset all the id's associated"",!?5,""with ALL patients."" G 7"
^MAGD(2006.79,25,1,66,0)=" G Q7:%'=1"
^MAGD(2006.79,25,1,67,0)=" S VAOPT=7 D TASK^VADPT61 G Q7"
^MAGD(2006.79,25,1,68,0)="QUE7 S VALL="""" D BEG^VADPT61,ALL,END^VADPT61"
^MAGD(2006.79,25,1,69,0)="Q7 K VALL"
^MAGD(2006.79,25,1,70,0)=" Q"
^MAGD(2006.79,25,1,71,0)=" ;"
^MAGD(2006.79,25,1,72,0)="FILE ;"
^MAGD(2006.79,25,1,73,0)=" S $P(^DPT(DFN,""E"",0),U,2)=""2.0361P"""
^MAGD(2006.79,25,1,74,0)=" I $D(^DPT(DFN,""E"",VAELG,0)) D IX G PATQ"
^MAGD(2006.79,25,1,75,0)=" L +^DPT(DFN,""E"",VAELG)"
^MAGD(2006.79,25,1,76,0)=" S $P(^(0),""^"",3,4)=VAELG_""^""_($P(^DPT(DFN,""E"",0),""^"",4)+1)"
^MAGD(2006.79,25,1,77,0)=" S ^DPT(DFN,""E"",VAELG,0)=VAELG"
^MAGD(2006.79,25,1,78,0)=" L -^DPT(DFN,""E"",VAELG)"
^MAGD(2006.79,25,1,79,0)=" S DA(1)=DFN,DA=VAELG,DIK=""^DPT(""_DA(1)_"",""""E"""","",DIK(1)="".01"" D EN1^DIK"
^MAGD(2006.79,25,1,80,0)=" K DA,DIK Q"
^MAGD(2006.79,25,1,81,0)="PATQ Q"
^MAGD(2006.79,25,1,82,0)=" ;"
^MAGD(2006.79,25,1,83,0)="IX ;"
^MAGD(2006.79,25,1,84,0)=" S DA(1)=DFN,DA=VAELG,DIK=""^DPT(""_DA(1)_"",""""E"""","",DIK(1)="".01^3"" D EN^DIK"
^MAGD(2006.79,25,1,85,0)=" K DA,DIK Q"
^MAGD(2006.79,25,1,86,0)=" ;"
^MAGD(2006.79,25,1,87,0)="ALL ; -- resets all id's for all pt's"
^MAGD(2006.79,25,1,88,0)=" ;    if VALL not defined then only primary reset"
^MAGD(2006.79,25,1,89,0)=" F DFN=0:0 S DFN=$O(^DPT(DFN)) Q:'DFN  D PRI I $D(VALL) F VAELG=0:0 S VAELG=$O(^DPT(DFN,""E"",VAELG)) Q:'VAELG  D IX:VAELG'=VAPRI"
^MAGD(2006.79,25,1,90,0)=" K VAPRI,DFN,VAELG"
^MAGD(2006.79,25,1,91,0)=" Q"
^MAGD(2006.79,25,1,92,0)=" ;"
^MAGD(2006.79,25,1,93,0)="PRI ; -- set/reset pri elig id"
^MAGD(2006.79,25,1,94,0)=" S VAPRI=0"
^MAGD(2006.79,25,1,95,0)=" I $D(^DPT(DFN,.36)) S (VAPRI,VAELG)=+^(.36) I $D(^DIC(8,VAELG,0)) D FILE"
^MAGD(2006.79,25,1,96,0)=" Q"
^MAGD(2006.79,25,1,97,0)=" ;"
^MAGD(2006.79,25,1,98,0)="UPDT ; -- called by v5 clean-up"
^MAGD(2006.79,25,1,99,0)=" W !,"">>>PRIMARY ELIGIBILITY ID UPDATE..."""
^MAGD(2006.79,25,1,100,0)=" D 41 Q"
^MAGD(2006.79,26,0)="VADPT61^3050311.125837"
^MAGD(2006.79,26,1,0)="^2006.791^60^60"
^MAGD(2006.79,26,1,1,0)="VADPT61 ;ALB/MJK - Patient ID Utilities (cont.); 12 AUG 89 @1200"
^MAGD(2006.79,26,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
^MAGD(2006.79,26,1,3,0)=" ;"
^MAGD(2006.79,26,1,4,0)="1 ;;ID Format Enter/Edit"
^MAGD(2006.79,26,1,5,0)=" W ! S DIC=""^DIC(8.2,"",DIC(0)=""AELMQ"" D ^DIC K DIC G Q1:+Y<1"
^MAGD(2006.79,26,1,6,0)=" S DA=+Y,DIE=""^DIC(8.2,"",DR=""[DG ID FORMAT ENTER/EDIT]"" D ^DIE G 1"
^MAGD(2006.79,26,1,7,0)="Q1 K DIE,DR,DA,Y Q"
^MAGD(2006.79,26,1,8,0)=" ;"
^MAGD(2006.79,26,1,9,0)="2 ;;Eligibility Code Enter/Edit"
^MAGD(2006.79,26,1,10,0)=" W ! S DIC=""^DIC(8,"",DIC(0)=""AELMQ"",DIC(""DR"")=8 D ^DIC K DIC G Q2:+Y<1"
^MAGD(2006.79,26,1,11,0)=" S DA=+Y,DIE=""^DIC(8,"",DR=""[DG ELIG ENTER/EDIT]"" D ^DIE G 2"
^MAGD(2006.79,26,1,12,0)="Q2 K DIE,DR,DA,Y"
^MAGD(2006.79,26,1,13,0)=" Q"
^MAGD(2006.79,26,1,14,0)=" ;"
^MAGD(2006.79,26,1,15,0)="ASK ;"
^MAGD(2006.79,26,1,16,0)=" Q:$S('$D(^DIC(8.2,+$P(^DIC(8,VAELG,0),U,10),0)):1,1:'$P(^(0),U,2))"
^MAGD(2006.79,26,1,17,0)=" W !!,*7,""User Input Needed for '"",$P(^DIC(8,VAELG,0),U),""' id:"""
^MAGD(2006.79,26,1,18,0)=" S DIE=""^DPT(""_DFN_"",""""E"""","",DR=.03,DA(1)=DFN,DA=VAELG D ^DIE"
^MAGD(2006.79,26,1,19,0)=" W !!?5,""..."",$P(^DIC(8,VAELG,0),U)"
^MAGD(2006.79,26,1,20,0)=" K DIE,DR,DA,Y"
^MAGD(2006.79,26,1,21,0)=" Q"
^MAGD(2006.79,26,1,22,0)=" ;"
^MAGD(2006.79,26,1,23,0)="WARN ; -- interaction warning"
^MAGD(2006.79,26,1,24,0)=" I $P(X,U,2) W !!?5,*7,""WARNING: User interaction usually is required for this format."""
^MAGD(2006.79,26,1,25,0)=" Q"
^MAGD(2006.79,26,1,26,0)=" ;"
^MAGD(2006.79,26,1,27,0)="BEG ;"
^MAGD(2006.79,26,1,28,0)=" D NOW^%DTC S VASTART=%"
^MAGD(2006.79,26,1,29,0)=" Q"
^MAGD(2006.79,26,1,30,0)=" ;"
^MAGD(2006.79,26,1,31,0)="END ;"
^MAGD(2006.79,26,1,32,0)=" D NOW^%DTC S VAEND=%,L=0"
^MAGD(2006.79,26,1,33,0)=" K XMY"
^MAGD(2006.79,26,1,34,0)=" S XMSUB=$P($T(OPTS+VAOPT),"";"",4),XMDUZ=.5,XMTEXT=""VATEXT("",XMY(DUZ)="""""
^MAGD(2006.79,26,1,35,0)=" I VAOPT=3 S XMSUB=XMSUB_"" (Format: ""_$S($D(^DIC(8.2,VAFMT,0)):$P(^(0),U),1:""UNKNOWN"")_"")"""
^MAGD(2006.79,26,1,36,0)=" I VAOPT=5 S XMSUB=XMSUB_"" (Eligibility: ""_$S($D(^DIC(8,VAELG,0)):$P(^(0),U),1:""UNKNOWN"")_"")"""
^MAGD(2006.79,26,1,37,0)=" S L=L+1 S VATEXT(L,0)="" """
^MAGD(2006.79,26,1,38,0)=" S Y=VASTART,L=L+1 X ^DD(""DD"") S VATEXT(L,0)=""  Job started   at ""_Y"
^MAGD(2006.79,26,1,39,0)=" S Y=VAEND,L=L+1 X ^DD(""DD"") S VATEXT(L,0)=""  Job completed at ""_Y"
^MAGD(2006.79,26,1,40,0)=" D ^XMD"
^MAGD(2006.79,26,1,41,0)=" K VAOPT,VASTART,VAEND,L,VATEXT,XMY,XMSUB,XMDUZ,XMTEXT,Y,% Q"
^MAGD(2006.79,26,1,42,0)=" ;"
^MAGD(2006.79,26,1,43,0)="TASK ;"
^MAGD(2006.79,26,1,44,0)=" W !!?5,""The resetting of ID formats can take many hours."""
^MAGD(2006.79,26,1,45,0)=" W !?5,""It is suggested that it be run at off-peak hours,"""
^MAGD(2006.79,26,1,46,0)=" W !?5,""perferably over a weekend."",!"
^MAGD(2006.79,26,1,47,0)=" K ZTSK S X=$T(OPTS+VAOPT),VARS=$P(X,"";"",5)"
^MAGD(2006.79,26,1,48,0)=" F I=1:1 S Y=$P(VARS,""^"",I) Q:Y=""""  S ZTSAVE(Y)="""""
^MAGD(2006.79,26,1,49,0)=" S ZTSAVE(""VAOPT"")="""",ZTRTN=""QUE""_VAOPT_""^VADPT60"",ZTDESC=$P(X,"";"",4),ZTIO="""" D ^%ZTLOAD"
^MAGD(2006.79,26,1,50,0)=" I $D(ZTSK) W !!,""Job has been queued. (Task #"",ZTSK,"")"",!,""A MailMan message will be sent to you when the job has completed."""
^MAGD(2006.79,26,1,51,0)="TASKQ K ZTIO,ZTRTN,ZTDESC,ZTSAVE,VARS,Y,X,ZTSK Q"
^MAGD(2006.79,26,1,52,0)=" ;"
^MAGD(2006.79,26,1,53,0)="OPTS ; -- queue task list ;;opt#;description;vars to save"
^MAGD(2006.79,26,1,54,0)=" ;;1;none"
^MAGD(2006.79,26,1,55,0)=" ;;2;none"
^MAGD(2006.79,26,1,56,0)=" ;;3;Reset ID Format;VAFMT"
^MAGD(2006.79,26,1,57,0)=" ;;4;Reset Primary Eligibilty ID Format"
^MAGD(2006.79,26,1,58,0)=" ;;5;Reset Specific Eligibilty ID Format;VAELG"
^MAGD(2006.79,26,1,59,0)=" ;;6;none"
^MAGD(2006.79,26,1,60,0)=" ;;7;Reset All ID Formats for all Patients"
^MAGD(2006.79,27,0)="VADPT62^3050311.125837"
^MAGD(2006.79,27,1,0)="^2006.791^50^50"
^MAGD(2006.79,27,1,1,0)="VADPT62 ;ALB/MJK - Patient ID Trigger Nodes ; 11 MAR 1991"
^MAGD(2006.79,27,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
^MAGD(2006.79,27,1,3,0)=" ;"
^MAGD(2006.79,27,1,4,0)=" ; This routine contains all the the 1 and 2 nodes for triggers"
^MAGD(2006.79,27,1,5,0)=" ; on fields in the PATIENT ELIGIBILITIES multiple of the"
^MAGD(2006.79,27,1,6,0)=" ; PATIENT file."
^MAGD(2006.79,27,1,7,0)=" ;"
^MAGD(2006.79,27,1,8,0)=" ; Because of the layered nature of the execution of these"
^MAGD(2006.79,27,1,9,0)=" ; triggers, M11+ could not handle their execution reliably."
^MAGD(2006.79,27,1,10,0)=" ; Store errors would sometimes occur."
^MAGD(2006.79,27,1,11,0)=" ;"
^MAGD(2006.79,27,1,12,0)=" ; By placing the code for these nodes in this rouitne, the operating"
^MAGD(2006.79,27,1,13,0)=" ; system will not have use up as much symbol space to store the"
^MAGD(2006.79,27,1,14,0)=" ; executeable code. The 1 and 2 nodes now only contain calls"
^MAGD(2006.79,27,1,15,0)=" ; to the appropriate tag in this routine. [Tag 'P31' is the"
^MAGD(2006.79,27,1,16,0)=" ; tag called by the 3rd cross reference of the LONG ID field"
^MAGD(2006.79,27,1,17,0)=" ; to execute the 'set' logic of the trigger - ^DD(2.0361,.03,1,3,1).]"
^MAGD(2006.79,27,1,18,0)=" ;"
^MAGD(2006.79,27,1,19,0)="E31 ; -- first set node of ^DD(2.0361,.01,1,3,1) trigger on ELIGIBILITY field"
^MAGD(2006.79,27,1,20,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DPT(D0,""E"",D1,0)):^(0),1:"""") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(2.0361,.01,1,3,1.1) X ^DD(2.0361,.01,1,3,1.4)"
^MAGD(2006.79,27,1,21,0)=" Q"
^MAGD(2006.79,27,1,22,0)=" ;"
^MAGD(2006.79,27,1,23,0)="E32 ; -- first kill node of ^DD(2.0361,.01,1,3,2) trigger on ELIGIBILITY field"
^MAGD(2006.79,27,1,24,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DPT(D0,""E"",D1,0)):^(0),1:"""") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="""" X ^DD(2.0361,.01,1,3,2.4)"
^MAGD(2006.79,27,1,25,0)=" Q"
^MAGD(2006.79,27,1,26,0)=" ;"
^MAGD(2006.79,27,1,27,0)="L11 ; -- first set node of ^DD(2.0361,.03,1,1,1) trigger on LONG ID field"
^MAGD(2006.79,27,1,28,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DPT(D0,""E"",D1,0)):^(0),1:"""") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(2.0361,.03,1,1,1.1) X ^DD(2.0361,.03,1,1,1.4)"
^MAGD(2006.79,27,1,29,0)=" Q"
^MAGD(2006.79,27,1,30,0)=" ;"
^MAGD(2006.79,27,1,31,0)="L12 ; -- first kill node of ^DD(2.0361,.03,1,1,2) trigger on LONG ID field"
^MAGD(2006.79,27,1,32,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DPT(D0,""E"",D1,0)):^(0),1:"""") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="""" X ^DD(2.0361,.03,1,1,2.4)"
^MAGD(2006.79,27,1,33,0)=" Q"
^MAGD(2006.79,27,1,34,0)=" ;"
^MAGD(2006.79,27,1,35,0)="L31 ; -- first set node of ^DD(2.0361,.03,1,3,1) trigger on LONG ID field"
^MAGD(2006.79,27,1,36,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA S Y(0)=X S X=$S('$D(^DPT(DA(1),.36)):0,1:DA=+^(.36)) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.36)):^(.36),1:"""") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(2.0361,.03,1,3,1.4)"
^MAGD(2006.79,27,1,37,0)=" Q"
^MAGD(2006.79,27,1,38,0)=" ;"
^MAGD(2006.79,27,1,39,0)="L32 ; -- first kill node of ^DD(2.0361,.03,1,3,2) trigger on LONG ID"
^MAGD(2006.79,27,1,40,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA S Y(0)=X S X=$S('$D(^DPT(DA(1),.36)):0,1:DA=+^(.36)) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.36)):^(.36),1:"""") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="""" X ^DD(2.0361,.03,1,3,2.4)"
^MAGD(2006.79,27,1,41,0)=" Q"
^MAGD(2006.79,27,1,42,0)=" ;"
^MAGD(2006.79,27,1,43,0)="S31 ; -- first set node of ^DD(2.0361,.04,1,3,1) trigger on SHORT ID field"
^MAGD(2006.79,27,1,44,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA S Y(0)=X S X=$S('$D(^DPT(DA(1),.36)):0,1:DA=+^(.36)) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.36)):^(.36),1:"""") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(2.0361,.04,1,3,1.4)"
^MAGD(2006.79,27,1,45,0)=" Q"
^MAGD(2006.79,27,1,46,0)=" ;"
^MAGD(2006.79,27,1,47,0)="S32 ; -- first kill node of ^DD(2.0361,.04,1,3,2) trigger on SHORT ID field"
^MAGD(2006.79,27,1,48,0)=" K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA S Y(0)=X S X=$S('$D(^DPT(DA(1),.36)):0,1:DA=+^(.36)) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.36)):^(.36),1:"""") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="""" X ^DD(2.0361,.04,1,3,2.4)"
^MAGD(2006.79,27,1,49,0)=" Q"
^MAGD(2006.79,27,1,50,0)=" ;"
^MAGD(2006.79,28,0)="XLFDT^3050311.125837"
^MAGD(2006.79,28,1,0)="^2006.791^178^178"
^MAGD(2006.79,28,1,1,0)="XLFDT ;ISC-SF/STAFF - Date/Time Functions ;03/27/2003  14:09"
^MAGD(2006.79,28,1,2,0)=" ;;8.0;KERNEL;**71,120,166,168,179,280**;Jul 10, 1995"
^MAGD(2006.79,28,1,3,0)=" ;VA FileMan uses 2400 as midnight, many other system use 0000."
^MAGD(2006.79,28,1,4,0)=" ;This is true for $H and HL7, so a conversion has to adjust"
^MAGD(2006.79,28,1,5,0)=" ;the day when converting Midnight."
^MAGD(2006.79,28,1,6,0)=" ;i.e. 3001225.24 is the same as HL7 '200012260000' and $H '58434,0'"
^MAGD(2006.79,28,1,7,0)=" ;The range of accepted $H dates: ""2,0"" to ""99999,85399""."
^MAGD(2006.79,28,1,8,0)=" ;The range of accepted FM dates: 1410102 to 4141015 (any valid time)."
^MAGD(2006.79,28,1,9,0)=" ;The range of accepted HL7 dates: 18410102 to 21141015 (any valid time)."
^MAGD(2006.79,28,1,10,0)=" ;It is expected that input values are valid dates."
^MAGD(2006.79,28,1,11,0)=" ;"
^MAGD(2006.79,28,1,12,0)="HTFM(%H,%F) ;$H to FM, %F=1 for date only"
^MAGD(2006.79,28,1,13,0)=" N X,%,%T,%Y,%M,%D S:'$D(%F) %F=0"
^MAGD(2006.79,28,1,14,0)=" I $$HR(%H) Q -1 ;Check Range"
^MAGD(2006.79,28,1,15,0)=" I '%F,%H["",0"" S %H=(%H-1)_"",86400"""
^MAGD(2006.79,28,1,16,0)=" D YMD S:%T&('%F) X=X_%T"
^MAGD(2006.79,28,1,17,0)=" Q X"
^MAGD(2006.79,28,1,18,0)=" ;"
^MAGD(2006.79,28,1,19,0)="H2F(%H) ;Internal to this routine use"
^MAGD(2006.79,28,1,20,0)=" N X,%,%T,%Y,%M,%D"
^MAGD(2006.79,28,1,21,0)=" D YMD S:%T X=X_%T"
^MAGD(2006.79,28,1,22,0)=" Q X"
^MAGD(2006.79,28,1,23,0)=" ;"
^MAGD(2006.79,28,1,24,0)="YMD ;21608 = 28 feb 1900, 94657 = 28 feb 2100, 141 $H base year"
^MAGD(2006.79,28,1,25,0)=" S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1"
^MAGD(2006.79,28,1,26,0)=" S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1"
^MAGD(2006.79,28,1,27,0)=" S X=%Y_""00""+%M_""00""+%D,%=$P(%H,"","",2)"
^MAGD(2006.79,28,1,28,0)=" S %T=%#60/100+(%#3600\60)/100+(%\3600)/100 S:'%T %T="".0"""
^MAGD(2006.79,28,1,29,0)=" Q"
^MAGD(2006.79,28,1,30,0)=" ;"
^MAGD(2006.79,28,1,31,0)="FMTH(X,%F) ;FM to $H, %F=1 for date only"
^MAGD(2006.79,28,1,32,0)=" N %Y,%H,%A S:'$D(%F) %F=0"
^MAGD(2006.79,28,1,33,0)=" I $$FR(X) Q -1 ;$H range of 1 - 99999"
^MAGD(2006.79,28,1,34,0)=" I '%F,X["".24"" S %A=1"
^MAGD(2006.79,28,1,35,0)=" D H S:%F %H=+%H I $D(%A) S %H=(%H+1)_"",0"""
^MAGD(2006.79,28,1,36,0)=" Q %H"
^MAGD(2006.79,28,1,37,0)=" ;"
^MAGD(2006.79,28,1,38,0)="F2H(X) ;Internal to this routine use"
^MAGD(2006.79,28,1,39,0)=" N %Y,%H,%A"
^MAGD(2006.79,28,1,40,0)=" D H"
^MAGD(2006.79,28,1,41,0)=" Q %H"
^MAGD(2006.79,28,1,42,0)=" ;"
^MAGD(2006.79,28,1,43,0)="H ;Build %H from FM"
^MAGD(2006.79,28,1,44,0)=" N %,%L,%M,%D,%T I X<1410101 S %H=0,%Y=-1 Q"
^MAGD(2006.79,28,1,45,0)=" S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)"
^MAGD(2006.79,28,1,46,0)=" S %T=$E(X_0,9,10)*60+$E(X_""000"",11,12)*60+$E(X_""00000"",13,14)"
^MAGD(2006.79,28,1,47,0)=" ;%L = (# leap years) - (# leap years before base)"
^MAGD(2006.79,28,1,48,0)=" S %L=%Y+1700 S:%M<3 %L=%L-1 S %L=(%L\4)-(%L\100)+(%L\400)-446"
^MAGD(2006.79,28,1,49,0)=" S %H=$P(""^31^59^90^120^151^181^212^243^273^304^334"",""^"",%M)+%D"
^MAGD(2006.79,28,1,50,0)=" S %=('%M)!('%D),%Y=%Y-141,%H=(%H+(%Y*365)+%L+%)_"",""_%T,%Y=$S(%:-1,1:%H+4#7)"
^MAGD(2006.79,28,1,51,0)=" Q"
^MAGD(2006.79,28,1,52,0)=" ;"
^MAGD(2006.79,28,1,53,0)="HTE(%H,%F) ;$H to external"
^MAGD(2006.79,28,1,54,0)=" Q:$$HR(%H) %H ;Range Check"
^MAGD(2006.79,28,1,55,0)=" N Y,%T,%R"
^MAGD(2006.79,28,1,56,0)=" S %F=$G(%F,1) S Y=$$HTFM(%H,0) G T2"
^MAGD(2006.79,28,1,57,0)=" ;"
^MAGD(2006.79,28,1,58,0)="FMTE(Y,%F) ;FM to external"
^MAGD(2006.79,28,1,59,0)=" Q:(Y<1000000)!(Y>9991231) Y ;Range Check"
^MAGD(2006.79,28,1,60,0)=" N %T,%R S %F=$G(%F,1)"
^MAGD(2006.79,28,1,61,0)=" ;Both HTE and FMTE come here."
^MAGD(2006.79,28,1,62,0)="T2 S %T="".""_$E($P(Y,""."",2)_""000000"",1,7)"
^MAGD(2006.79,28,1,63,0)=" D FMT^XLFDT1 Q %R"
^MAGD(2006.79,28,1,64,0)=" ;"
^MAGD(2006.79,28,1,65,0)="FR(%V) ;Check FM in valid range"
^MAGD(2006.79,28,1,66,0)=" Q (%V<1410102)!(%V>4141015.235959)"
^MAGD(2006.79,28,1,67,0)="HR(%V) ;Check $H in valid range"
^MAGD(2006.79,28,1,68,0)=" Q (%V<2)!(%V>99999)"
^MAGD(2006.79,28,1,69,0)=" ;"
^MAGD(2006.79,28,1,70,0)="FMTHL7(%P1) ;Convert FM date/time to HL7 format"
^MAGD(2006.79,28,1,71,0)=" N %T Q:'$L(%P1) """" S %P1=+%P1 ;Make sure a cononic number"
^MAGD(2006.79,28,1,72,0)=" I $$FR(%P1) Q -1 ;Check range"
^MAGD(2006.79,28,1,73,0)=" S %T=$P(%P1,""."",2),%P1=$P(%P1,""."")"
^MAGD(2006.79,28,1,74,0)=" I %T=24 S %P1=$$FMADD($P(%P1,"".""),1),%T=""0000"""
^MAGD(2006.79,28,1,75,0)=" S:%P1>1 %P1=%P1+17000000"
^MAGD(2006.79,28,1,76,0)=" I $L(%T) S %T=$S($L(%T)>4:$E(%T_""00"",1,6),1:$E(%T_""0000"",1,4))"
^MAGD(2006.79,28,1,77,0)=" I $L(%T) S %P1=%P1_%T_$$TZ()"
^MAGD(2006.79,28,1,78,0)=" Q %P1"
^MAGD(2006.79,28,1,79,0)=" ;"
^MAGD(2006.79,28,1,80,0)="HL7TFM(%P1,%P2,%P3) ;Convert HL7 D/T to FM."
^MAGD(2006.79,28,1,81,0)=" ;%P1 is the value to convert"
^MAGD(2006.79,28,1,82,0)=" ;%P2 is if output should be local or UCT time (L,U)"
^MAGD(2006.79,28,1,83,0)=" ;%P3 is 1 if the input just a time value?"
^MAGD(2006.79,28,1,84,0)=" N %TZ,%LTZ,%SN,%U,%H,%M,%T Q:'$L(%P1) """""
^MAGD(2006.79,28,1,85,0)=" S %T=$E(%P1_""0000"",1,8)"
^MAGD(2006.79,28,1,86,0)=" S %P2=$G(%P2),%P3=+$G(%P3),%TZ="""",%LTZ=$$TZ()"
^MAGD(2006.79,28,1,87,0)=" I '%P3 Q:(%T<18410102)!(%T>21141015) -1 ;Date Range Check"
^MAGD(2006.79,28,1,88,0)=" F %SN=""+"",""-"" I %P1[%SN D  Q  ;Find the timezone"
^MAGD(2006.79,28,1,89,0)=" . S %TZ=$P(%P1,%SN,2),%P1=$P(%P1,%SN) I %TZ'?4N S %TZ="""" Q"
^MAGD(2006.79,28,1,90,0)=" . S %TZ=%SN_%TZ"
^MAGD(2006.79,28,1,91,0)=" . Q"
^MAGD(2006.79,28,1,92,0)=" ;FM only supports time to seconds"
^MAGD(2006.79,28,1,93,0)=" S %P1=$P(%P1,""."")"
^MAGD(2006.79,28,1,94,0)=" ;See it just a Time value"
^MAGD(2006.79,28,1,95,0)=" I %P3 S %P1=""20000104""_%P1 ;Add a date"
^MAGD(2006.79,28,1,96,0)=" Q:($L(%P1)#2)!(%P1'?4.14N) -1 ;Length check"
^MAGD(2006.79,28,1,97,0)=" I $L(%P1)<8 S %P1=$E(%P1_""00000000"",1,8) ;Fill out to 8 digits"
^MAGD(2006.79,28,1,98,0)=" I %TZ="""" D"
^MAGD(2006.79,28,1,99,0)=" . S:%P2[""L"" %P2="""" ;If no TZ, assume local, don't need L."
^MAGD(2006.79,28,1,100,0)=" . S:%P2[""U"" %TZ=%LTZ ;give the local tz"
^MAGD(2006.79,28,1,101,0)=" ;"
^MAGD(2006.79,28,1,102,0)=" S %P1=$S($L(%P1)>8:$E(%P1,1,8)-17000000_"".""_$E(%P1,9,14),1:%P1-17000000)"
^MAGD(2006.79,28,1,103,0)=" ;%P1 is now in FM format"
^MAGD(2006.79,28,1,104,0)=" I %P1[""."",+$P(%P1,""."",2)=0 S %P1=$$FMADD(+%P1,-1)_"".24"""
^MAGD(2006.79,28,1,105,0)=" ;If HL7 tz and local tz are the same"
^MAGD(2006.79,28,1,106,0)=" I %P2[""L"",%TZ=%LTZ S %P2="""""
^MAGD(2006.79,28,1,107,0)=" I (%P2[""U"")!(%P2[""L""),%P1[""."" D  ;Build UCT from data"
^MAGD(2006.79,28,1,108,0)=" . S %=$TR(%TZ,""+-"",""-+"") ;Reverse the sign"
^MAGD(2006.79,28,1,109,0)=" . S %H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)"
^MAGD(2006.79,28,1,110,0)=" . S %P1=$$FMADD(%P1,,%H,%M) Q"
^MAGD(2006.79,28,1,111,0)=" ;"
^MAGD(2006.79,28,1,112,0)=" I %P2[""L"",%P1[""."" D  ;Build local from UCT"
^MAGD(2006.79,28,1,113,0)=" . S %=$$TZ(),%H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)"
^MAGD(2006.79,28,1,114,0)=" . S %P1=$$FMADD(%P1,,%H,%M) Q"
^MAGD(2006.79,28,1,115,0)=" Q +$S(%P3:"".""_$P(%P1,""."",2),1:%P1)"
^MAGD(2006.79,28,1,116,0)=" ;"
^MAGD(2006.79,28,1,117,0)="DOW(X,Y) ;Day of Week"
^MAGD(2006.79,28,1,118,0)=" N %Y,%M,%D,%H,%T D H I $G(Y) Q %Y"
^MAGD(2006.79,28,1,119,0)=" Q $P(""Sun^Mon^Tues^Wednes^Thurs^Fri^Satur"",""^"",%Y+1)_""day"""
^MAGD(2006.79,28,1,120,0)=" ;"
^MAGD(2006.79,28,1,121,0)="FMDIFF(X1,X2,X3) ;FM diff in two dates. if X3=1 in days, if X3=2 in seconds."
^MAGD(2006.79,28,1,122,0)=" N %H,%Y,X"
^MAGD(2006.79,28,1,123,0)=" S X1=$G(X1),X2=$G(X2),X3=$G(X3,1)"
^MAGD(2006.79,28,1,124,0)=" S:$$FR(X1) X1=0 S:$$FR(X2) X2=0 ;Check range, Use 0 for bad values"
^MAGD(2006.79,28,1,125,0)=" S X=X1 D H S X1=+%H,X1(1)=$P(%H,"","",2),X=X2 D H"
^MAGD(2006.79,28,1,126,0)=" ;Both FMDIFF and HDIFF come here."
^MAGD(2006.79,28,1,127,0)="D2 S X=(X1-%H) S:X3>1 X=X*86400+(X1(1)-$P(%H,"","",2))"
^MAGD(2006.79,28,1,128,0)=" I X3=3 S %=X,X="""" S:%'<86400 X=(%\86400) S:%#86400 X=X_"" ""_(%#86400\3600)_"":""_$E(%#3600\60+100,2,3)_"":""_$E(%#60+100,2,3)"
^MAGD(2006.79,28,1,129,0)=" Q X"
^MAGD(2006.79,28,1,130,0)=" ;"
^MAGD(2006.79,28,1,131,0)="HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF."
^MAGD(2006.79,28,1,132,0)=" N X,%H,%T"
^MAGD(2006.79,28,1,133,0)=" S:$$HR(X1) X1=""1,1"" S:$$HR(X2) X2=""1,1"" ;Check range, use ""1,1"" for bad values"
^MAGD(2006.79,28,1,134,0)=" S X3=$G(X3,1)"
^MAGD(2006.79,28,1,135,0)=" S X1(1)=$P(X1,"","",2),X1=+X1,%H=X2"
^MAGD(2006.79,28,1,136,0)=" G D2"
^MAGD(2006.79,28,1,137,0)=" ;"
^MAGD(2006.79,28,1,138,0)="HADD(X,D,H,M,S) ;Add to $H date"
^MAGD(2006.79,28,1,139,0)=" N %H,%T"
^MAGD(2006.79,28,1,140,0)=" Q:$$HR(X) -1 ;Check Range"
^MAGD(2006.79,28,1,141,0)=" S %H=+X,%T=$P(X,"","",2) D A2 Q %H_"",""_%T"
^MAGD(2006.79,28,1,142,0)=" ;"
^MAGD(2006.79,28,1,143,0)="A2 S %H=%H+$G(D),%T=%T+($G(H)*3600)+($G(M)*60)+$G(S) ;add days and seconds"
^MAGD(2006.79,28,1,144,0)=" ;S:%T'<86400 %H=%H+(%T\86400),%T=%T#86400 S:%T<0 %H=%H+(%T\86400)-1,%T=%T#86400"
^MAGD(2006.79,28,1,145,0)=" S %H=%H+(%T\86400) I %T<0,(%T#86400'=0) S %H=%H-1 ;Adj for sec>day"
^MAGD(2006.79,28,1,146,0)=" S %T=%T#86400"
^MAGD(2006.79,28,1,147,0)=" Q"
^MAGD(2006.79,28,1,148,0)=" ;"
^MAGD(2006.79,28,1,149,0)="FMADD(X,D,H,M,S) ;Add to FM date"
^MAGD(2006.79,28,1,150,0)=" N %H,%T,%P"
^MAGD(2006.79,28,1,151,0)=" Q:$$FR(X) -1 ;Check Range"
^MAGD(2006.79,28,1,152,0)=" S %P=X[""."",%H=$$F2H(X),%T=$P(%H,"","",2) D A2"
^MAGD(2006.79,28,1,153,0)=" I %P,%T=0 S %H=%H-1,%T=86400"
^MAGD(2006.79,28,1,154,0)=" Q $$H2F(%H_"",""_%T)"
^MAGD(2006.79,28,1,155,0)=" ;"
^MAGD(2006.79,28,1,156,0)="NOW() ;Current Date/time in FM."
^MAGD(2006.79,28,1,157,0)=" Q $$HTFM($H)"
^MAGD(2006.79,28,1,158,0)=" ;"
^MAGD(2006.79,28,1,159,0)="DT() ;Current Date in FM."
^MAGD(2006.79,28,1,160,0)=" Q $$HTFM($H,1)\1"
^MAGD(2006.79,28,1,161,0)=" ;"
^MAGD(2006.79,28,1,162,0)="SCH(SCH,LTM,FF) ;Find the next D/T given a schedule, start time."
^MAGD(2006.79,28,1,163,0)=" Q $$DECODE^XLFDT2"
^MAGD(2006.79,28,1,164,0)=" ;"
^MAGD(2006.79,28,1,165,0)="WITHIN(XLSCH,XLD) ;See if D/T is within schedule"
^MAGD(2006.79,28,1,166,0)=" G WITHIN^XLFDT4"
^MAGD(2006.79,28,1,167,0)=" ;"
^MAGD(2006.79,28,1,168,0)="SEC(%) ;Convert $H to seconds."
^MAGD(2006.79,28,1,169,0)=" I %?7.N.""."".N S %=$$FMTH(%) ;Check for FM date"
^MAGD(2006.79,28,1,170,0)=" Q 86400*%+$P(%,"","",2)"
^MAGD(2006.79,28,1,171,0)=" ;"
^MAGD(2006.79,28,1,172,0)="%H(%) ;Covert from seconds to $H"
^MAGD(2006.79,28,1,173,0)=" Q (%\86400)_"",""_(%#86400)"
^MAGD(2006.79,28,1,174,0)=" ;"
^MAGD(2006.79,28,1,175,0)="TZ() ;Return current Time Zone from Mailman parameter file"
^MAGD(2006.79,28,1,176,0)=" N %T,%S"
^MAGD(2006.79,28,1,177,0)=" S %T=$P($G(^XMB(4.4,+$P($G(^XMB(1,1,0)),""^"",2),0)),""^"",3),%S=$S(%T[""-"":""-"",1:""+""),%T=$TR(%T,""-+"")"
^MAGD(2006.79,28,1,178,0)=" Q %S_$E(100+%T,2,3)_$S(%T["".5"":""30"",1:""00"")"
^MAGD(2006.79,29,0)="XUMF333^3050311.125837"
^MAGD(2006.79,29,1,0)="^2006.791^356^356"
^MAGD(2006.79,29,1,1,0)="XUMF333 ;OIFO-OAK/RAM - Add HCS data types ;02/21/02"
^MAGD(2006.79,29,1,2,0)=" ;;8.0;KERNEL;**335**;Jul 10, 1995"
^MAGD(2006.79,29,1,3,0)=" ;"
^MAGD(2006.79,29,1,4,0)=" Q"
^MAGD(2006.79,29,1,5,0)=" ;"
^MAGD(2006.79,29,1,6,0)=" ;"
^MAGD(2006.79,29,1,7,0)="POST ; -- post installation XU*8*333"
^MAGD(2006.79,29,1,8,0)=" ;"
^MAGD(2006.79,29,1,9,0)=" N XUMF,IENS,IEN,FDA,I,HCS,XXX"
^MAGD(2006.79,29,1,10,0)=" ;"
^MAGD(2006.79,29,1,11,0)=" S XUMF=1"
^MAGD(2006.79,29,1,12,0)=" ;"
^MAGD(2006.79,29,1,13,0)=" D KM,KM1,KM2,KM3,STUFF"
^MAGD(2006.79,29,1,14,0)=" ;"
^MAGD(2006.79,29,1,15,0)=" Q"
^MAGD(2006.79,29,1,16,0)=" ;"
^MAGD(2006.79,29,1,17,0)="KM ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
^MAGD(2006.79,29,1,18,0)=" ;"
^MAGD(2006.79,29,1,19,0)=" N X,Y"
^MAGD(2006.79,29,1,20,0)=" ;"
^MAGD(2006.79,29,1,21,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
^MAGD(2006.79,29,1,22,0)=" S Y=""?+1,"""
^MAGD(2006.79,29,1,23,0)=" ;"
^MAGD(2006.79,29,1,24,0)=" S IENS=Y_X_"","""
^MAGD(2006.79,29,1,25,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
^MAGD(2006.79,29,1,26,0)=" S FDA(19.01,""?+2,?1,"",.01)=""XUMF IMF EDIT STATUS"""
^MAGD(2006.79,29,1,27,0)=" D UPDATE^DIE("""",""FDA"")"
^MAGD(2006.79,29,1,28,0)=" ;"
^MAGD(2006.79,29,1,29,0)=" Q"
^MAGD(2006.79,29,1,30,0)=" ;"
^MAGD(2006.79,29,1,31,0)="KM1 ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
^MAGD(2006.79,29,1,32,0)=" ;"
^MAGD(2006.79,29,1,33,0)=" N X,Y"
^MAGD(2006.79,29,1,34,0)=" ;"
^MAGD(2006.79,29,1,35,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
^MAGD(2006.79,29,1,36,0)=" S Y=""?+1,"""
^MAGD(2006.79,29,1,37,0)=" ;"
^MAGD(2006.79,29,1,38,0)=" S IENS=Y_X_"","""
^MAGD(2006.79,29,1,39,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
^MAGD(2006.79,29,1,40,0)=" S FDA(19.01,""?+3,?1,"",.01)=""XUMF LOAD INSTITUTION"""
^MAGD(2006.79,29,1,41,0)=" D UPDATE^DIE("""",""FDA"")"
^MAGD(2006.79,29,1,42,0)=" ;"
^MAGD(2006.79,29,1,43,0)=" Q"
^MAGD(2006.79,29,1,44,0)=" ;"
^MAGD(2006.79,29,1,45,0)="KM2 ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
^MAGD(2006.79,29,1,46,0)=" ;"
^MAGD(2006.79,29,1,47,0)=" N X,Y"
^MAGD(2006.79,29,1,48,0)=" ;"
^MAGD(2006.79,29,1,49,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
^MAGD(2006.79,29,1,50,0)=" S Y=""?+1,"""
^MAGD(2006.79,29,1,51,0)=" ;"
^MAGD(2006.79,29,1,52,0)=" S IENS=Y_X_"","""
^MAGD(2006.79,29,1,53,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
^MAGD(2006.79,29,1,54,0)=" S FDA(19.01,""?+3,?1,"",.01)=""Patch XU*8*335 clean 4.1 and 4"""
^MAGD(2006.79,29,1,55,0)=" D UPDATE^DIE("""",""FDA"")"
^MAGD(2006.79,29,1,56,0)=" ;"
^MAGD(2006.79,29,1,57,0)=" Q"
^MAGD(2006.79,29,1,58,0)=" ;"
^MAGD(2006.79,29,1,59,0)="KM3 ; -- remove XUMF333 clean 4.1 and 4 if present"
^MAGD(2006.79,29,1,60,0)=" ;"
^MAGD(2006.79,29,1,61,0)=" N X,IENS,FDA"
^MAGD(2006.79,29,1,62,0)=" ;"
^MAGD(2006.79,29,1,63,0)=" S X=$$FIND1^DIC(19,,""B"",""XUMF333 clean 4.1 and 4"")"
^MAGD(2006.79,29,1,64,0)=" ;"
^MAGD(2006.79,29,1,65,0)=" Q:'X"
^MAGD(2006.79,29,1,66,0)=" ;"
^MAGD(2006.79,29,1,67,0)=" S IENS=X_"","""
^MAGD(2006.79,29,1,68,0)=" S FDA(19,IENS,.01)=""@"""
^MAGD(2006.79,29,1,69,0)=" D UPDATE^DIE("""",""FDA"")"
^MAGD(2006.79,29,1,70,0)=" ;"
^MAGD(2006.79,29,1,71,0)=" Q"
^MAGD(2006.79,29,1,72,0)=" ;"
^MAGD(2006.79,29,1,73,0)="STUFF ;"
^MAGD(2006.79,29,1,74,0)=" ;"
^MAGD(2006.79,29,1,75,0)=" S IEN=$O(^DIC(4.1,""B"",""HCS"",0))"
^MAGD(2006.79,29,1,76,0)=" S IENS=$S(IEN:IEN_"","",1:""+1,"")"
^MAGD(2006.79,29,1,77,0)=" K FDA"
^MAGD(2006.79,29,1,78,0)=" S FDA(4.1,IENS,.01)=""HCS"""
^MAGD(2006.79,29,1,79,0)=" S FDA(4.1,IENS,1)=""HEALTH CARE SYSTEM"""
^MAGD(2006.79,29,1,80,0)=" S FDA(4.1,IENS,3)=""LOCAL"""
^MAGD(2006.79,29,1,81,0)=" D UPDATE^DIE(""E"",""FDA"")"
^MAGD(2006.79,29,1,82,0)=" ;"
^MAGD(2006.79,29,1,83,0)=" S HCS="""""
^MAGD(2006.79,29,1,84,0)=" F XXX=1:1 D  Q:HCS="""""
^MAGD(2006.79,29,1,85,0)=" .S HCS=$P($T(HCS+XXX),"";;"",2)"
^MAGD(2006.79,29,1,86,0)=" .S IEN=$S(HCS="""":0,1:$O(^DIC(4,""B"",HCS,0)))"
^MAGD(2006.79,29,1,87,0)=" .S IENS=$S(IEN:IEN_"","",1:""+1,"")"
^MAGD(2006.79,29,1,88,0)=" .;"
^MAGD(2006.79,29,1,89,0)=" .K FDA"
^MAGD(2006.79,29,1,90,0)=" .S FDA(4,IENS,.01)=HCS"
^MAGD(2006.79,29,1,91,0)=" .S FDA(4,IENS,11)=""LOCAL"""
^MAGD(2006.79,29,1,92,0)=" .S FDA(4,IENS,13)=""HCS"""
^MAGD(2006.79,29,1,93,0)=" .D UPDATE^DIE(""E"",""FDA"")"
^MAGD(2006.79,29,1,94,0)=" ;"
^MAGD(2006.79,29,1,95,0)=" Q"
^MAGD(2006.79,29,1,96,0)=" ;"
^MAGD(2006.79,29,1,97,0)="HCS ;"
^MAGD(2006.79,29,1,98,0)=" ;;VA GREATER LOS ANGELES (691)"
^MAGD(2006.79,29,1,99,0)=" ;;VA HEARTLAND-EAST VISN15 (657)"
^MAGD(2006.79,29,1,100,0)=" ;;VA HEARTLAND-WEST VISN15 (589)"
^MAGD(2006.79,29,1,101,0)=" ;;VA CHICAGO HSC (537)"
^MAGD(2006.79,29,1,102,0)=" ;;CENTRAL PLAINS NETWORK (636)"
^MAGD(2006.79,29,1,103,0)=" ;;MONTANA HCS (436)"
^MAGD(2006.79,29,1,104,0)=" ;;VA PACIFIC ISLANDS HCS (459)"
^MAGD(2006.79,29,1,105,0)=" ;;NEW MEXICO HCS (501)"
^MAGD(2006.79,29,1,106,0)=" ;;AMARILLO HCS (504)"
^MAGD(2006.79,29,1,107,0)=" ;;MARYLAND HCS (512)"
^MAGD(2006.79,29,1,108,0)=" ;;WEST TEXAS HCS (519)"
^MAGD(2006.79,29,1,109,0)=" ;;BOSTON HCS (523)"
^MAGD(2006.79,29,1,110,0)=" ;;UPSTATE NEW YORK HCS (528)"
^MAGD(2006.79,29,1,111,0)=" ;;NORTH TEXAS HCS (549)"
^MAGD(2006.79,29,1,112,0)=" ;;EASTERN COLORADO HCS (554)"
^MAGD(2006.79,29,1,113,0)=" ;;NEW JERSEY HCS (561)"
^MAGD(2006.79,29,1,114,0)=" ;;BLACK HILLS HCS (568)"
^MAGD(2006.79,29,1,115,0)=" ;;CENTRAL CALIFORNIA HCS (570)"
^MAGD(2006.79,29,1,116,0)=" ;;N FLORIDA/S GEORGIA HCS (573)"
^MAGD(2006.79,29,1,117,0)=" ;;GREATER NEBRASKA HCS (597)"
^MAGD(2006.79,29,1,118,0)=" ;;CENTRAL ARKANSAS HCS (598)"
^MAGD(2006.79,29,1,119,0)=" ;;LONG BEACH HCS (600)"
^MAGD(2006.79,29,1,120,0)=" ;;CENTRAL ALABAMA HCS (619)"
^MAGD(2006.79,29,1,121,0)=" ;;HUDSON VALLEY HCS VAMC (620)"
^MAGD(2006.79,29,1,122,0)=" ;;TENNESSEE VALLEY HCS (626)"
^MAGD(2006.79,29,1,123,0)=" ;;PALO ALTO HCS (640)"
^MAGD(2006.79,29,1,124,0)=" ;;PITTSBURGH HCS (646)"
^MAGD(2006.79,29,1,125,0)=" ;;ROSEBURG HCS (653)"
^MAGD(2006.79,29,1,126,0)=" ;;SIERRA NEVADA HCS (654)"
^MAGD(2006.79,29,1,127,0)=" ;;SALT LAKE CITY HCS (660)"
^MAGD(2006.79,29,1,128,0)=" ;;PUGET SOUND HCS (663)"
^MAGD(2006.79,29,1,129,0)=" ;;SAN DIEGO HCS (664)"
^MAGD(2006.79,29,1,130,0)=" ;;SOUTH TEXAS HCS (671)"
^MAGD(2006.79,29,1,131,0)=" ;;CENTRAL TEXAS HCS (674)"
^MAGD(2006.79,29,1,132,0)=" ;;EASTERN KANSAS HCS (677)"
^MAGD(2006.79,29,1,133,0)=" ;;SOUTHERN ARIZONA VA HCS (678)"
^MAGD(2006.79,29,1,134,0)=" ;;CONNECTICUT HCS (689)"
^MAGD(2006.79,29,1,135,0)=" ;;EL PASO VA HCS (756)"
^MAGD(2006.79,29,1,136,0)=" ;;NEW YORK HHS (630)"
^MAGD(2006.79,29,1,137,0)=" ;"
^MAGD(2006.79,29,1,138,0)=" ; do not include"
^MAGD(2006.79,29,1,139,0)=" ;;EASTERN COLORADO HCS (554A4)"
^MAGD(2006.79,29,1,140,0)=" ;;SOUTHERN COLORADO HCS"
^MAGD(2006.79,29,1,141,0)=" ;;CENTRAL IOWA HCS (555)"
^MAGD(2006.79,29,1,142,0)=" ;;ILLIANA HCS (550)"
^MAGD(2006.79,29,1,143,0)=" ;;NORTHERN CALIFORNIA HCS (612)"
^MAGD(2006.79,29,1,144,0)=" ;;SOUTHERN NEVADA HCS (593)"
^MAGD(2006.79,29,1,145,0)=" ;;NORTHERN ARIZONA HCS (649)"
^MAGD(2006.79,29,1,146,0)=" ;"
^MAGD(2006.79,29,1,147,0)=" Q"
^MAGD(2006.79,29,1,148,0)=" ;"
^MAGD(2006.79,29,1,149,0)="CHK ; -- check site updating required"
^MAGD(2006.79,29,1,150,0)=" ;"
^MAGD(2006.79,29,1,151,0)=" N STA,IEN,FLAG,CHK"
^MAGD(2006.79,29,1,152,0)=" ;"
^MAGD(2006.79,29,1,153,0)=" S STA=$$STA^XUAF4(+$G(DUZ(2)))"
^MAGD(2006.79,29,1,154,0)=" ;"
^MAGD(2006.79,29,1,155,0)=" I STA="""" W !!,""DUZ not defined.  Please log on."" Q"
^MAGD(2006.79,29,1,156,0)=" ;"
^MAGD(2006.79,29,1,157,0)=" W @IOF,!,STA,"" "",$P($$NS^XUAF4(+DUZ(2)),U)"
^MAGD(2006.79,29,1,158,0)=" ;"
^MAGD(2006.79,29,1,159,0)=" S CHK=$$INST^XUMF333(+DUZ(2),.ERR)"
^MAGD(2006.79,29,1,160,0)=" I CHK=1 D"
^MAGD(2006.79,29,1,161,0)=" .W !!?5,""MISSING DATA - please fix"",!"
^MAGD(2006.79,29,1,162,0)=" .S I=0 F  S I=$O(ERR(""FATAL"",I)) Q:'I  D"
^MAGD(2006.79,29,1,163,0)=" ..W !?5,ERR(""FATAL"",I)"
^MAGD(2006.79,29,1,164,0)=" I CHK'=1 W "" is okay"""
^MAGD(2006.79,29,1,165,0)=" ;"
^MAGD(2006.79,29,1,166,0)=" S STA=STA_""A"""
^MAGD(2006.79,29,1,167,0)=" F  S STA=$O(^DIC(4,""D"",STA)) Q:STA=""""  D  Q:$G(FLAG)"
^MAGD(2006.79,29,1,168,0)=" .I $E($$STA^XUAF4(DUZ(2)),1,3)'=$E(STA,1,3) S FLAG=1 Q"
^MAGD(2006.79,29,1,169,0)=" .S IEN=$$IEN^XUAF4(STA)"
^MAGD(2006.79,29,1,170,0)=" .S CHK=$$INST^XUMF333(+IEN,.ERR)"
^MAGD(2006.79,29,1,171,0)=" .W !!,STA,"" "",$P($$NS^XUAF4(+IEN),U)"
^MAGD(2006.79,29,1,172,0)=" .I CHK'=1 W "" is okay"" Q"
^MAGD(2006.79,29,1,173,0)=" .I CHK=1 D"
^MAGD(2006.79,29,1,174,0)=" ..W "" is MISSING DATA - please fix"",!"
^MAGD(2006.79,29,1,175,0)=" ..S I=0 F  S I=$O(ERR(""FATAL"",I)) Q:'I  D"
^MAGD(2006.79,29,1,176,0)=" ...W !?5,ERR(""FATAL"",I)"
^MAGD(2006.79,29,1,177,0)=" .K ERR"
^MAGD(2006.79,29,1,178,0)=" ;"
^MAGD(2006.79,29,1,179,0)=" ;"
^MAGD(2006.79,29,1,180,0)=" Q"
^MAGD(2006.79,29,1,181,0)=" ;"
^MAGD(2006.79,29,1,182,0)="INST(IEN,ERR) ; -- validate Institution entry FALSE=valid"
^MAGD(2006.79,29,1,183,0)=" ;"
^MAGD(2006.79,29,1,184,0)=" Q:'$G(IEN) ""IEN null"""
^MAGD(2006.79,29,1,185,0)=" ;"
^MAGD(2006.79,29,1,186,0)=" S CNT=1"
^MAGD(2006.79,29,1,187,0)=" ;"
^MAGD(2006.79,29,1,188,0)=" D ZERO(IEN,.ERR,.CNT)"
^MAGD(2006.79,29,1,189,0)=" D ADD1(IEN,.ERR,.CNT)"
^MAGD(2006.79,29,1,190,0)=" D ADD2(IEN,.ERR,.CNT)"
^MAGD(2006.79,29,1,191,0)=" D FTYP(IEN,.ERR,.CNT)"
^MAGD(2006.79,29,1,192,0)=" D ND99(IEN,.ERR,.CNT)"
^MAGD(2006.79,29,1,193,0)=" ;"
^MAGD(2006.79,29,1,194,0)=" Q $S($D(ERR(""FATAL"")):1,$D(ERR(""WARNING"")):2,1:0)"
^MAGD(2006.79,29,1,195,0)=" ;"
^MAGD(2006.79,29,1,196,0)="ZERO(IEN,ERR,CNT) ; -- zero node"
^MAGD(2006.79,29,1,197,0)=" ;"
^MAGD(2006.79,29,1,198,0)=" N X"
^MAGD(2006.79,29,1,199,0)=" ;"
^MAGD(2006.79,29,1,200,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
^MAGD(2006.79,29,1,201,0)=" ;"
^MAGD(2006.79,29,1,202,0)=" S X=$G(^DIC(4,+IEN,0))"
^MAGD(2006.79,29,1,203,0)=" I $P(X,U,2)="""" D"
^MAGD(2006.79,29,1,204,0)=" .S ERR(""FATAL"",CNT)=""STATE is missing"",CNT=CNT+1"
^MAGD(2006.79,29,1,205,0)=" ;"
^MAGD(2006.79,29,1,206,0)=" Q"
^MAGD(2006.79,29,1,207,0)=" ;"
^MAGD(2006.79,29,1,208,0)="ADD1(IEN,ERR,CNT) ; -- address node"
^MAGD(2006.79,29,1,209,0)=" ;"
^MAGD(2006.79,29,1,210,0)=" N X,I"
^MAGD(2006.79,29,1,211,0)=" ;"
^MAGD(2006.79,29,1,212,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
^MAGD(2006.79,29,1,213,0)=" ;"
^MAGD(2006.79,29,1,214,0)=" S X=$G(^DIC(4,+IEN,1))"
^MAGD(2006.79,29,1,215,0)=" I $P(X,U,1)="""" D"
^MAGD(2006.79,29,1,216,0)=" .S ERR(""FATAL"",CNT)=""Physical address St. line 1 missing"""
^MAGD(2006.79,29,1,217,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,218,0)=" I $P(X,U,3)="""" D"
^MAGD(2006.79,29,1,219,0)=" .S ERR(""FATAL"",CNT)=""Physical address City missing"""
^MAGD(2006.79,29,1,220,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,221,0)=" I $P(X,U,4)="""" D"
^MAGD(2006.79,29,1,222,0)=" .S ERR(""FATAL"",CNT)=""Physical address ZIP missing"""
^MAGD(2006.79,29,1,223,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,224,0)=" I $P(X,U,2)="""" D"
^MAGD(2006.79,29,1,225,0)=" .S ERR(""WARNING"",CNT)=""Physical address St. line 2 missing"""
^MAGD(2006.79,29,1,226,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,227,0)=" ;"
^MAGD(2006.79,29,1,228,0)=" Q"
^MAGD(2006.79,29,1,229,0)=" ;"
^MAGD(2006.79,29,1,230,0)="ADD2(IEN,ERR,CNT) ; -- mailing address node"
^MAGD(2006.79,29,1,231,0)=" ;"
^MAGD(2006.79,29,1,232,0)=" N X,I"
^MAGD(2006.79,29,1,233,0)=" ;"
^MAGD(2006.79,29,1,234,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
^MAGD(2006.79,29,1,235,0)=" ;"
^MAGD(2006.79,29,1,236,0)=" S X=$G(^DIC(4,+IEN,4))"
^MAGD(2006.79,29,1,237,0)=" I $P(X,U,1)="""" D"
^MAGD(2006.79,29,1,238,0)=" .S ERR(""FATAL"",CNT)=""Mailing address St. line 1 missing"""
^MAGD(2006.79,29,1,239,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,240,0)=" I $P(X,U,3)="""" D"
^MAGD(2006.79,29,1,241,0)=" .S ERR(""FATAL"",CNT)=""Mailing address City missing"""
^MAGD(2006.79,29,1,242,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,243,0)=" I $P(X,U,4)="""" D"
^MAGD(2006.79,29,1,244,0)=" .S ERR(""FATAL"",CNT)=""Mailing address State missing"""
^MAGD(2006.79,29,1,245,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,246,0)=" I $P(X,U,5)="""" D"
^MAGD(2006.79,29,1,247,0)=" .S ERR(""FATAL"",CNT)=""Mailing address ZIP missing"""
^MAGD(2006.79,29,1,248,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,249,0)=" I $P(X,U,2)="""" D"
^MAGD(2006.79,29,1,250,0)=" .S ERR(""WARNING"",CNT)=""Mailing address St. line 2 missing"""
^MAGD(2006.79,29,1,251,0)=" .S CNT=CNT+1"
^MAGD(2006.79,29,1,252,0)=" ;"
^MAGD(2006.79,29,1,253,0)=" Q"
^MAGD(2006.79,29,1,254,0)=" ;"
^MAGD(2006.79,29,1,255,0)="FTYP(IEN,ERR,CNT) ; -- facility type node"
^MAGD(2006.79,29,1,256,0)=" ;"
^MAGD(2006.79,29,1,257,0)=" N X"
^MAGD(2006.79,29,1,258,0)=" ;"
^MAGD(2006.79,29,1,259,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
^MAGD(2006.79,29,1,260,0)=" ;"
^MAGD(2006.79,29,1,261,0)=" S X=$G(^DIC(4,+IEN,3))"
^MAGD(2006.79,29,1,262,0)=" I 'X D"
^MAGD(2006.79,29,1,263,0)=" .S ERR(""FATAL"",CNT)=""FACILITY TYPE is missing"",CNT=CNT+1"
^MAGD(2006.79,29,1,264,0)=" I $P($G(^DIC(4.1,+X,0)),U,4)'=""N"" D"
^MAGD(2006.79,29,1,265,0)=" .S ERR(""FATAL"",CNT)=""FACILITY TYPE is not NATIONAL"",CNT=CNT+1"
^MAGD(2006.79,29,1,266,0)=" ;"
^MAGD(2006.79,29,1,267,0)=" Q"
^MAGD(2006.79,29,1,268,0)=" ;"
^MAGD(2006.79,29,1,269,0)="ND99(IEN,ERR,CNT) ; -- 99 node"
^MAGD(2006.79,29,1,270,0)=" ;"
^MAGD(2006.79,29,1,271,0)=" N X"
^MAGD(2006.79,29,1,272,0)=" ;"
^MAGD(2006.79,29,1,273,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
^MAGD(2006.79,29,1,274,0)=" ;"
^MAGD(2006.79,29,1,275,0)=" S X=$G(^DIC(4,+IEN,99))"
^MAGD(2006.79,29,1,276,0)=" I $P(X,U,3)="""" D"
^MAGD(2006.79,29,1,277,0)=" .S ERR(""FATAL"",CNT)=""OFFICIAL VA NAME is missing"",CNT=CNT+1"
^MAGD(2006.79,29,1,278,0)=" I ($P(X,U,4))&($E($$NS^XUAF4(+IEN),1,2)'=""ZZ"") D"
^MAGD(2006.79,29,1,279,0)=" .S ERR(""FATAL"",CNT)=""Inactive facility NAME not ZZ'd"",CNT=CNT+1"
^MAGD(2006.79,29,1,280,0)=" ;"
^MAGD(2006.79,29,1,281,0)=" Q"
^MAGD(2006.79,29,1,282,0)=" ;"
^MAGD(2006.79,29,1,283,0)="C4 ; -- clean up Institution file"
^MAGD(2006.79,29,1,284,0)=" ;"
^MAGD(2006.79,29,1,285,0)=" D RIP,CFTYP,GET"
^MAGD(2006.79,29,1,286,0)=" ;"
^MAGD(2006.79,29,1,287,0)=" Q"
^MAGD(2006.79,29,1,288,0)=" ;"
^MAGD(2006.79,29,1,289,0)="RIP ; -- remove from all inactive and local the associations visn & parent"
^MAGD(2006.79,29,1,290,0)=" ;"
^MAGD(2006.79,29,1,291,0)=" N IEN"
^MAGD(2006.79,29,1,292,0)=" ;"
^MAGD(2006.79,29,1,293,0)=" S IEN=0"
^MAGD(2006.79,29,1,294,0)=" F  S IEN=$O(^DIC(4,IEN)) Q:'IEN  D"
^MAGD(2006.79,29,1,295,0)=" .I $P($G(^DIC(4,+IEN,0)),U,11)=""N"",'$P($G(^DIC(4,+IEN,99)),U,4) Q"
^MAGD(2006.79,29,1,296,0)=" .D IFF^XUMF333(IEN)"
^MAGD(2006.79,29,1,297,0)=" ;"
^MAGD(2006.79,29,1,298,0)=" Q"
^MAGD(2006.79,29,1,299,0)=" ;"
^MAGD(2006.79,29,1,300,0)="IFF(IEN) ; -- inactive facility remove VISN and parent association"
^MAGD(2006.79,29,1,301,0)=" ;"
^MAGD(2006.79,29,1,302,0)=" N FDA,IENS,XUMF"
^MAGD(2006.79,29,1,303,0)=" ;"
^MAGD(2006.79,29,1,304,0)=" S XUMF=1"
^MAGD(2006.79,29,1,305,0)=" ;"
^MAGD(2006.79,29,1,306,0)=" S IENS=""1,""_IEN_"","""
^MAGD(2006.79,29,1,307,0)=" S FDA(4.014,IENS,.01)=""@"""
^MAGD(2006.79,29,1,308,0)=" S IENS=""2,""_IEN_"","""
^MAGD(2006.79,29,1,309,0)=" S FDA(4.014,IENS,.01)=""@"""
^MAGD(2006.79,29,1,310,0)=" D FILE^DIE(""E"",""FDA"")"
^MAGD(2006.79,29,1,311,0)=" ;"
^MAGD(2006.79,29,1,312,0)=" Q"
^MAGD(2006.79,29,1,313,0)=" ;"
^MAGD(2006.79,29,1,314,0)="CFTYP ; - clean 4.1"
^MAGD(2006.79,29,1,315,0)=" ;"
^MAGD(2006.79,29,1,316,0)=" N FDA,IENS,XUMF,IEN"
^MAGD(2006.79,29,1,317,0)=" ;"
^MAGD(2006.79,29,1,318,0)=" M ^TMP(""XUMF 4.1"",$J)=^DIC(4.1)"
^MAGD(2006.79,29,1,319,0)=" ;"
^MAGD(2006.79,29,1,320,0)=" S XUMF=1"
^MAGD(2006.79,29,1,321,0)=" ;"
^MAGD(2006.79,29,1,322,0)=" S IEN=0"
^MAGD(2006.79,29,1,323,0)=" F  S IEN=$O(^DIC(4.1,IEN)) Q:'IEN  D"
^MAGD(2006.79,29,1,324,0)=" .S IENS=IEN_"","""
^MAGD(2006.79,29,1,325,0)=" .K FDA"
^MAGD(2006.79,29,1,326,0)=" .S FDA(4.1,IENS,.01)=""@"""
^MAGD(2006.79,29,1,327,0)=" .D FILE^DIE(""E"",""FDA"")"
^MAGD(2006.79,29,1,328,0)=" ;"
^MAGD(2006.79,29,1,329,0)=" S IEN=0"
^MAGD(2006.79,29,1,330,0)=" F  S IEN=$O(^DIC(4,IEN)) Q:'IEN  D"
^MAGD(2006.79,29,1,331,0)=" .S IENS=IEN_"","""
^MAGD(2006.79,29,1,332,0)=" .K FDA"
^MAGD(2006.79,29,1,333,0)=" .S FDA(4,IENS,13)=""@"""
^MAGD(2006.79,29,1,334,0)=" .D FILE^DIE(""E"",""FDA"")"
^MAGD(2006.79,29,1,335,0)=" ;"
^MAGD(2006.79,29,1,336,0)=" Q"
^MAGD(2006.79,29,1,337,0)=" ;"
^MAGD(2006.79,29,1,338,0)="GET ; -- get Institution Master File (IMF) and Facility Types"
^MAGD(2006.79,29,1,339,0)=" ;"
^MAGD(2006.79,29,1,340,0)=" W !!,""...getting Facility Types - wait please 5 min..."""
^MAGD(2006.79,29,1,341,0)=" D LOAD^XUMF(4.1)"
^MAGD(2006.79,29,1,342,0)=" W !!,""...getting Institutions - wait please 10 min..."""
^MAGD(2006.79,29,1,343,0)=" D LOAD^XUMF(4)"
^MAGD(2006.79,29,1,344,0)=" ;"
^MAGD(2006.79,29,1,345,0)=" Q"
^MAGD(2006.79,29,1,346,0)=" ;"
^MAGD(2006.79,29,1,347,0)="SCN(IEN,XUMF) ; screen out HCS entries"
^MAGD(2006.79,29,1,348,0)=" ;"
^MAGD(2006.79,29,1,349,0)=" ; IEN = Institution Internal Entry Number to check"
^MAGD(2006.79,29,1,350,0)=" ;"
^MAGD(2006.79,29,1,351,0)=" S XUMF=$G(XUMF) Q:XUMF 1"
^MAGD(2006.79,29,1,352,0)=" ;"
^MAGD(2006.79,29,1,353,0)=" I $O(^DIC(4.1,""B"",""HCS"",0))=+$G(^DIC(4,+IEN,3)) Q 0"
^MAGD(2006.79,29,1,354,0)=" ;"
^MAGD(2006.79,29,1,355,0)=" Q 1"
^MAGD(2006.79,29,1,356,0)=" ;"
^MAGD(2006.79,30,0)="XUSRB1^3050311.125837"
^MAGD(2006.79,30,1,0)="^2006.791^66^66"
^MAGD(2006.79,30,1,1,0)="XUSRB1 ;iscSF/RWF - More Request Broker ;6/8/04  16:41"
^MAGD(2006.79,30,1,2,0)=" ;;8.0;KERNEL;**28,82,135,275**;Jul 10, 1995"
^MAGD(2006.79,30,1,3,0)=" Q  ;No entry from top"
^MAGD(2006.79,30,1,4,0)=" ;"
^MAGD(2006.79,30,1,5,0)="DECRYP(S) ;decrypt passed string"
^MAGD(2006.79,30,1,6,0)=" ;VYD 5/19/95"
^MAGD(2006.79,30,1,7,0)=" N ASSOCIX,IDIX,ASSOCSTR,IDSTR"
^MAGD(2006.79,30,1,8,0)=" Q:$L(S)'>2 """" ;Bad call"
^MAGD(2006.79,30,1,9,0)=" S ASSOCIX=$A($E(S,$L(S)))-31           ;get associator string index"
^MAGD(2006.79,30,1,10,0)=" S IDIX=$A($E(S))-31                    ;get identifier string index"
^MAGD(2006.79,30,1,11,0)=" S ASSOCSTR=$P($T(Z+ASSOCIX),"";"",3,9)   ;get associator string"
^MAGD(2006.79,30,1,12,0)=" S IDSTR=$P($T(Z+IDIX),"";"",3,9)         ;get identifier string"
^MAGD(2006.79,30,1,13,0)=" Q $TR($E(S,2,$L(S)-1),ASSOCSTR,IDSTR)  ;translated result"
^MAGD(2006.79,30,1,14,0)=" ;"
^MAGD(2006.79,30,1,15,0)="ENCRYP(S) ;RWF 2/5/96"
^MAGD(2006.79,30,1,16,0)=" N %,ASSOCIX,IDIX,ASSOCSTR,IDSTR"
^MAGD(2006.79,30,1,17,0)=" S ASSOCIX=$R(20)+1                     ;get associator index"
^MAGD(2006.79,30,1,18,0)=" F  S IDIX=$R(20)+1 Q:ASSOCIX'=IDIX     ;get different identifier index"
^MAGD(2006.79,30,1,19,0)=" S ASSOCSTR=$P($T(Z+ASSOCIX),"";"",3,9)   ;get associator string"
^MAGD(2006.79,30,1,20,0)=" S IDSTR=$P($T(Z+IDIX),"";"",3,9)         ;get identifier string"
^MAGD(2006.79,30,1,21,0)=" ;translated result"
^MAGD(2006.79,30,1,22,0)=" Q $C(IDIX+31)_$TR(S,IDSTR,ASSOCSTR)_$C(ASSOCIX+31)"
^MAGD(2006.79,30,1,23,0)=" ;"
^MAGD(2006.79,30,1,24,0)="SENDKEYS(RESULT) ;send encryption keys to the client"
^MAGD(2006.79,30,1,25,0)=" ;VYD 5/19/95"
^MAGD(2006.79,30,1,26,0)=" N %,X"
^MAGD(2006.79,30,1,27,0)=" S %=1"
^MAGD(2006.79,30,1,28,0)=" F  S X=$P($T(Z+%),"";"",3,9) Q:X=""""  S RESULT(%)=X,%=%+1"
^MAGD(2006.79,30,1,29,0)=" Q"
^MAGD(2006.79,30,1,30,0)=" ;"
^MAGD(2006.79,30,1,31,0)="BLDDRUM Q  ;don't run this tag"
^MAGD(2006.79,30,1,32,0)=" N I,%,ALLCHARS,RNDMSTR,CHAR"
^MAGD(2006.79,30,1,33,0)=" X ""ZP Z""                      ;position insertion point"
^MAGD(2006.79,30,1,34,0)=" F I=1:1:20 D"
^MAGD(2006.79,30,1,35,0)=" . S ALLCHARS="""" F %=32:1:126 S:$C(%)'=""^"" ALLCHARS=ALLCHARS_$C(%)"
^MAGD(2006.79,30,1,36,0)=" . S RNDMSTR="""""
^MAGD(2006.79,30,1,37,0)=" . F %=1:1:94 D"
^MAGD(2006.79,30,1,38,0)=" . . S POS=$R($L(ALLCHARS))+1,CHAR=$E(ALLCHARS,POS)"
^MAGD(2006.79,30,1,39,0)=" . . S RNDMSTR=RNDMSTR_CHAR"
^MAGD(2006.79,30,1,40,0)=" . . S ALLCHARS=$P(ALLCHARS,CHAR,1)_$P(ALLCHARS,CHAR,2) ;compress by 1"
^MAGD(2006.79,30,1,41,0)=" . X ""ZI """" ;;""""_RNDMSTR""      ;save random string in routine"
^MAGD(2006.79,30,1,42,0)=" X ""ZS""                        ;save routine"
^MAGD(2006.79,30,1,43,0)=" Q"
^MAGD(2006.79,30,1,44,0)=" ;"
^MAGD(2006.79,30,1,45,0)=" ;"
^MAGD(2006.79,30,1,46,0)="Z ;;"
^MAGD(2006.79,30,1,47,0)=" ;;wkEo-ZJt!dG)49K{nX1BS$vH<&:Myf*>Ae0jQW=;|#PsO`'%+rmb[gpqN,l6/hFC@DcUa ]z~R}""V\iIxu?872.(TYL5_3"
^MAGD(2006.79,30,1,48,0)=" ;;rKv`R;M/9BqAF%&tSs#Vh)dO1DZP> *fX'u[.4lY=-mg_ci802N7LTG<]!CWo:3?{+,5Q}(@jaExn$~p\IyHwzU""|k6Jeb"
^MAGD(2006.79,30,1,49,0)=" ;;\pV(ZJk""WQmCn!Y,y@1d+~8s?[lNMxgHEt=uw|X:qSLjAI*}6zoF{T3#;ca)/h5%`P4$r]G'9e2if_>UDKb7<v0&- RBO."
^MAGD(2006.79,30,1,50,0)=" ;;depjt3g4W)qD0V~NJar\B ""?OYhcu[<Ms%Z`RIL_6:]AX-zG.#}$@vk7/5x&*m;(yb2Fn+l'PwUof1K{9,|EQi>H=CT8S!"
^MAGD(2006.79,30,1,51,0)=" ;;NZW:1}K$byP;jk)7'`x90B|cq@iSsEnu,(l-hf.&Y_?J#R]+voQXU8mrV[!p4tg~OMez CAaGFD6H53%L/dT2<*>""{\wI="
^MAGD(2006.79,30,1,52,0)=" ;;vCiJ<oZ9|phXVNn)m K`t/SI%]A5qOWe\&?;jT~M!fz1l>[D_0xR32c*4.P""G{r7}E8wUgyudF+6-:B=$(sY,LkbHa#'@Q"
^MAGD(2006.79,30,1,53,0)=" ;;hvMX,'4Ty;[a8/{6l~F_V""}qLI\!@x(D7bRmUH]W15J%N0BYPkrs&9:$)Zj>u|zwQ=ieC-oGA.#?tfdcO3gp`S+En K2*<"
^MAGD(2006.79,30,1,54,0)=" ;;jd!W5[];4'<C$/&x|rZ(k{>?ghBzIFN}fAK""#`p_TqtD*1E37XGVs@0nmSe+Y6Qyo-aUu%i8c=H2vJ\) R:MLb.9,wlO~P"
^MAGD(2006.79,30,1,55,0)=" ;;2ThtjEM+!=xXb)7,ZV{*ci3""8@_l-HS69L>]\AUF/Q%:qD?1~m(yvO0e'<#o$p4dnIzKP|`NrkaGg.ufCRB[; sJYwW}5&"
^MAGD(2006.79,30,1,56,0)=" ;;vB\5/zl-9y:Pj|=(R'7QJI *&CTX""p0]_3.idcuOefVU#omwNZ`$Fs?L+1Sk<,b)hM4A6[Y%aDrg@~KqEW8t>H};n!2xG{"
^MAGD(2006.79,30,1,57,0)=" ;;sFz0Bo@_HfnK>LR}qWXV+D6`Y28=4Cm~G/7-5A\b9!a#rP.l&M$hc3ijQk;),TvUd<[:I""u1'NZSOw]*gxtE{eJp|y (?%"
^MAGD(2006.79,30,1,58,0)=" ;;M@,D}|LJyGO8`$*ZqH .j>c~h<d=fimszv[#-53F!+a;NC'6T91IV?(0x&/{B)w""]Q\YUWprk4:ol%g2nE7teRKbAPuS_X"
^MAGD(2006.79,30,1,59,0)=" ;;.mjY#_0*H<B=Q+FML6]s;r2:e8R}[ic&KA 1w{)vV5d,$u""~xD/Pg?IyfthO@CzWp%!`N4Z'3-(o|J9XUE7k\TlqSb>anG"
^MAGD(2006.79,30,1,60,0)=" ;;xVa1']_GU<X`|\NgM?LS9{""jT%s$}y[nvtlefB2RKJW~(/cIDCPow4,>#zm+:5b@06O3Ap8=*7ZFY!H-uEQk; .q)i&rhd"
^MAGD(2006.79,30,1,61,0)=" ;;I]Jz7AG@QX.""%3Lq>METUo{Pp_ |a6<0dYVSv8:b)~W9NK`(r'4fs&wim\kReC2hg=HOj$1B*/nxt,;c#y+![?lFuZ-5D}"
^MAGD(2006.79,30,1,62,0)=" ;;Rr(Ge6F Hx>q$m&C%M~Tn,:""o'tX/*yP.{lZ!YkiVhuw_<KE5a[;}W0gjsz3]@7cI2\QN?f#4p|vb1OUBD9)=-LJA+d`S8"
^MAGD(2006.79,30,1,63,0)=" ;;I~k>y|m};d)-7DZ""Fe/Y<B:xwojR,Vh]O0Sc[`$sg8GXE!1&Qrzp._W%TNK(=J 3i*2abuHA4C'?Mv\Pq{n#56LftUl@9+"
^MAGD(2006.79,30,1,64,0)=" ;;~A*>9 WidFN,1KsmwQ)GJM{I4:C%}#Ep(?HB/r;t.&U8o|l['Lg""2hRDyZ5`nbf]qjc0!zS-TkYO<_=76a\X@$Pe3+xVvu"
^MAGD(2006.79,30,1,65,0)=" ;;yYgjf""5VdHc#uA,W1i+v'6|@pr{n;DJ!8(btPGaQM.LT3oe?NB/&9>Z`-}02*%x<7lsqz4OS ~E$\R]KI[:UwC_=h)kXmF"
^MAGD(2006.79,30,1,66,0)=" ;;5:iar.{YU7mBZR@-K|2 ""+~`M%8sq4JhPo<_X\Sg3WC;Tuxz,fvEQ1p9=w}FAI&j/keD0c?)LN6OHV]lGy'$*>nd[(tb!#"
^MAGD(2006.79,"B","MCUIMAG0",1)=""
^MAGD(2006.79,"B","RARIC",2)=""
^MAGD(2006.79,"B","RARTE2",3)=""
^MAGD(2006.79,"B","RAUTL",4)=""
^MAGD(2006.79,"B","RAUTL1",5)=""
^MAGD(2006.79,"B","RAUTL2",6)=""
^MAGD(2006.79,"B","RAUTL20",7)=""
^MAGD(2006.79,"B","RAUTL3",8)=""
^MAGD(2006.79,"B","RAUTL5",9)=""
^MAGD(2006.79,"B","RAXREF",10)=""
^MAGD(2006.79,"B","TIULC1",11)=""
^MAGD(2006.79,"B","TIULS",12)=""
^MAGD(2006.79,"B","TIUSRVPL",13)=""
^MAGD(2006.79,"B","VADPT",14)=""
^MAGD(2006.79,"B","VADPT0",15)=""
^MAGD(2006.79,"B","VADPT1",16)=""
^MAGD(2006.79,"B","VADPT2",17)=""
^MAGD(2006.79,"B","VADPT3",18)=""
^MAGD(2006.79,"B","VADPT30",19)=""
^MAGD(2006.79,"B","VADPT31",20)=""
^MAGD(2006.79,"B","VADPT32",21)=""
^MAGD(2006.79,"B","VADPT4",22)=""
^MAGD(2006.79,"B","VADPT5",23)=""
^MAGD(2006.79,"B","VADPT6",24)=""
^MAGD(2006.79,"B","VADPT60",25)=""
^MAGD(2006.79,"B","VADPT61",26)=""
^MAGD(2006.79,"B","VADPT62",27)=""
^MAGD(2006.79,"B","XLFDT",28)=""
^MAGD(2006.79,"B","XUMF333",29)=""
^MAGD(2006.79,"B","XUSRB1",30)=""