[613] | 1 | FirstRelease WVEHR VER VOE1.0
|
---|
| 2 | Cache 31-Jan-2008 23:07:04 ZWR
|
---|
| 3 | ^MAGD(2006.5715,0)="CURRENT IMAGE^2006.5715^^"
|
---|
| 4 | ^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575^^"
|
---|
| 5 | ^MAGD(2006.599,0)="DICOM Error Log^2006.599^^"
|
---|
| 6 | ^MAGD(2006.79,0)="DICOM ROUTINE COPY^2006.79^30^30"
|
---|
| 7 | ^MAGD(2006.79,1,0)="MCUIMAG0^3060410.105553"
|
---|
| 8 | ^MAGD(2006.79,1,1,0)="^2006.791^242^242"
|
---|
| 9 | ^MAGD(2006.79,1,1,1,0)="MCUIMAG0 ;HCIOFO/DAD-Create / Update Med Procedure with Image Pointer ;7/23/97 07:36"
|
---|
| 10 | ^MAGD(2006.79,1,1,2,0)=" ;;2.3;Medicine;**7,12**;09/13/1996"
|
---|
| 11 | ^MAGD(2006.79,1,1,3,0)=" Q"
|
---|
| 12 | ^MAGD(2006.79,1,1,4,0)=" ;"
|
---|
| 13 | ^MAGD(2006.79,1,1,5,0)="UPDATE(MCDATE,MCPROCD0,MCDFN,MCMAGPTR,MCD0,OK) ;"
|
---|
| 14 | ^MAGD(2006.79,1,1,6,0)=" ; *** Main driver to update Medicine files from Imaging ***"
|
---|
| 15 | ^MAGD(2006.79,1,1,7,0)=" ; MCDATE = Date/Time of procedure (FM internal format)"
|
---|
| 16 | ^MAGD(2006.79,1,1,8,0)=" ; MCPROCD0 = Pointer to the Procedure/Subspecialty file (#697.2)"
|
---|
| 17 | ^MAGD(2006.79,1,1,9,0)=" ; MCDFN = Pointer to the Patient file (#2)"
|
---|
| 18 | ^MAGD(2006.79,1,1,10,0)=" ; MCMAGPTR() = An array whose subscripts are pointers to the Image"
|
---|
| 19 | ^MAGD(2006.79,1,1,11,0)=" ; file (#2005) Returned as: MCMAGPTR(File 2005 IEN)="
|
---|
| 20 | ^MAGD(2006.79,1,1,12,0)=" ; MCFILE ^ MCD0 ^ MCD1 (IEN of image in image mult)"
|
---|
| 21 | ^MAGD(2006.79,1,1,13,0)=" ; MCD0 = Pointer to one of the Medicine Procedure data files"
|
---|
| 22 | ^MAGD(2006.79,1,1,14,0)=" ; OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
|
---|
| 23 | ^MAGD(2006.79,1,1,15,0)=" N DD,DIC,DINUM,DO,MCPATFLD,X,Y"
|
---|
| 24 | ^MAGD(2006.79,1,1,16,0)=" S MCDATE=+$G(MCDATE),MCPROCD0=+$G(MCPROCD0)"
|
---|
| 25 | ^MAGD(2006.79,1,1,17,0)=" S MCDFN=+$G(MCDFN),MCD0=+$G(MCD0)"
|
---|
| 26 | ^MAGD(2006.79,1,1,18,0)=" S MCFILE=+$P($P($G(^MCAR(697.2,MCPROCD0,0)),U,2),""("",2)"
|
---|
| 27 | ^MAGD(2006.79,1,1,19,0)=" I MCFILE'>0 D Q"
|
---|
| 28 | ^MAGD(2006.79,1,1,20,0)=" . S OK=""0^Medicine Procedure file global location not found"""
|
---|
| 29 | ^MAGD(2006.79,1,1,21,0)=" . Q"
|
---|
| 30 | ^MAGD(2006.79,1,1,22,0)=" S MCPATFLD=$$PATFLD(MCFILE)"
|
---|
| 31 | ^MAGD(2006.79,1,1,23,0)=" I MCPATFLD'>0 D Q"
|
---|
| 32 | ^MAGD(2006.79,1,1,24,0)=" . S OK=""0^Medical Patient field not found in Medicine Procedure file"""
|
---|
| 33 | ^MAGD(2006.79,1,1,25,0)=" . Q"
|
---|
| 34 | ^MAGD(2006.79,1,1,26,0)=" I MCD0>0 S OK=$$VALID(MCFILE,MCD0,MCDFN,MCPROCD0) Q:'OK"
|
---|
| 35 | ^MAGD(2006.79,1,1,27,0)=" I MCD0'>0 D Q:'OK"
|
---|
| 36 | ^MAGD(2006.79,1,1,28,0)=" . N MCIEN S MCIEN=0"
|
---|
| 37 | ^MAGD(2006.79,1,1,29,0)=" . F S MCIEN=$O(^MCAR(MCFILE,""B"",MCDATE,MCIEN)) Q:MCIEN'>0 D Q:MCD0"
|
---|
| 38 | ^MAGD(2006.79,1,1,30,0)=" .. S OK=$$VALID(MCFILE,MCIEN,MCDFN,MCPROCD0)"
|
---|
| 39 | ^MAGD(2006.79,1,1,31,0)=" .. I OK S MCD0=MCIEN"
|
---|
| 40 | ^MAGD(2006.79,1,1,32,0)=" .. Q"
|
---|
| 41 | ^MAGD(2006.79,1,1,33,0)=" . I MCD0'>0 D NEW(MCDATE,MCDFN,MCFILE,MCPROCD0,MCPATFLD,.MCD0,.OK)"
|
---|
| 42 | ^MAGD(2006.79,1,1,34,0)=" . Q"
|
---|
| 43 | ^MAGD(2006.79,1,1,35,0)=" I $O(MCMAGPTR(0)) D FILE(MCD0,MCFILE,.MCMAGPTR,.OK) Q:'OK"
|
---|
| 44 | ^MAGD(2006.79,1,1,36,0)=" S MCD0=MCD0_U_MCFILE"
|
---|
| 45 | ^MAGD(2006.79,1,1,37,0)=" Q"
|
---|
| 46 | ^MAGD(2006.79,1,1,38,0)=" ;"
|
---|
| 47 | ^MAGD(2006.79,1,1,39,0)="NEW(MCDATE,MCDFN,MCFILE,MCPROCD0,MCPATFLD,MCD0,OK) ;"
|
---|
| 48 | ^MAGD(2006.79,1,1,40,0)=" ; *** Create new Medicine patient (if needed) and procedure records ***"
|
---|
| 49 | ^MAGD(2006.79,1,1,41,0)=" ; MCDATE = Date/Time of procedure (FM internal format)"
|
---|
| 50 | ^MAGD(2006.79,1,1,42,0)=" ; MCDFN = Pointer to the Patient file (#2)"
|
---|
| 51 | ^MAGD(2006.79,1,1,43,0)=" ; MCFILE = File number of one of the Medicine Procedure data files"
|
---|
| 52 | ^MAGD(2006.79,1,1,44,0)=" ; MCPROCD0 = Pointer to the Procedure/Subspecialty file (#697.2)"
|
---|
| 53 | ^MAGD(2006.79,1,1,45,0)=" ; MCPATFLD = Field# in one of the Medicine Procedure data files"
|
---|
| 54 | ^MAGD(2006.79,1,1,46,0)=" ; that points to the Medical Patient file (#690)"
|
---|
| 55 | ^MAGD(2006.79,1,1,47,0)=" ; MCD0 = Pointer to one of the Medicine Procedure data files"
|
---|
| 56 | ^MAGD(2006.79,1,1,48,0)=" ; OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
|
---|
| 57 | ^MAGD(2006.79,1,1,49,0)=" N DD,DIC,DINUM,DLAYGO,DO,MCARCODE,MCPRCFLD,MCRESULT,X,Y"
|
---|
| 58 | ^MAGD(2006.79,1,1,50,0)=" S OK=""1^New stub record created in Medicine Procedure data file"""
|
---|
| 59 | ^MAGD(2006.79,1,1,51,0)=" ; *** Create a new record in the Medical Patient file (#690) ***"
|
---|
| 60 | ^MAGD(2006.79,1,1,52,0)=" I '$D(^MCAR(690,MCDFN)) D Q:'OK"
|
---|
| 61 | ^MAGD(2006.79,1,1,53,0)=" . K DD,DIC,DINUM,DO"
|
---|
| 62 | ^MAGD(2006.79,1,1,54,0)=" . S (X,DINUM)=MCDFN,DLAYGO=690"
|
---|
| 63 | ^MAGD(2006.79,1,1,55,0)=" . S DIC=""^MCAR(690,"",DIC(0)=""L"""
|
---|
| 64 | ^MAGD(2006.79,1,1,56,0)=" . D FILE^DICN"
|
---|
| 65 | ^MAGD(2006.79,1,1,57,0)=" . I Y'>0 D"
|
---|
| 66 | ^MAGD(2006.79,1,1,58,0)=" .. S OK=""0^Cannot add patient to Medical Patient file"""
|
---|
| 67 | ^MAGD(2006.79,1,1,59,0)=" .. Q"
|
---|
| 68 | ^MAGD(2006.79,1,1,60,0)=" . Q"
|
---|
| 69 | ^MAGD(2006.79,1,1,61,0)=" ; *** Create a stub record ***"
|
---|
| 70 | ^MAGD(2006.79,1,1,62,0)=" K DD,DIC,DINUM,DO"
|
---|
| 71 | ^MAGD(2006.79,1,1,63,0)=" S DIC=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")"
|
---|
| 72 | ^MAGD(2006.79,1,1,64,0)=" S DIC(0)=""L"",DLAYGO=MCFILE"
|
---|
| 73 | ^MAGD(2006.79,1,1,65,0)=" S DIC(""DR"")=MCPATFLD_""///`""_MCDFN"
|
---|
| 74 | ^MAGD(2006.79,1,1,66,0)=" S MCARCODE=$P($G(^MCAR(697.2,MCPROCD0,0)),U,4) S:MCARCODE="""" MCARCODE=U"
|
---|
| 75 | ^MAGD(2006.79,1,1,67,0)=" S MCPRCFLD=$$PRCFLD(MCFILE)"
|
---|
| 76 | ^MAGD(2006.79,1,1,68,0)=" I MCPRCFLD>0 D PRCSUBS Q:'OK"
|
---|
| 77 | ^MAGD(2006.79,1,1,69,0)=" S X=MCDATE"
|
---|
| 78 | ^MAGD(2006.79,1,1,70,0)=" D FILE^DICN S MCD0=+Y"
|
---|
| 79 | ^MAGD(2006.79,1,1,71,0)=" I MCD0'>0 D"
|
---|
| 80 | ^MAGD(2006.79,1,1,72,0)=" . S OK=""0^Cannot create stub record in the Medicine Procedure data file"""
|
---|
| 81 | ^MAGD(2006.79,1,1,73,0)=" . Q"
|
---|
| 82 | ^MAGD(2006.79,1,1,74,0)=" Q"
|
---|
| 83 | ^MAGD(2006.79,1,1,75,0)=" ;"
|
---|
| 84 | ^MAGD(2006.79,1,1,76,0)="FILE(MCD0,MCFILE,MCMAGPTR,OK) ;"
|
---|
| 85 | ^MAGD(2006.79,1,1,77,0)=" ; *** Store the Image file (#2005) pointers in Med Proc data files ***"
|
---|
| 86 | ^MAGD(2006.79,1,1,78,0)=" ; MCD0 = Pointer to one of the Medicine Procedure data files"
|
---|
| 87 | ^MAGD(2006.79,1,1,79,0)=" ; MCFILE = File number of one of the Medicine Procedure data files"
|
---|
| 88 | ^MAGD(2006.79,1,1,80,0)=" ; MCMAGPTR() = An array whose subscripts are pointers to the Image"
|
---|
| 89 | ^MAGD(2006.79,1,1,81,0)=" ; file (#2005) Returned as: MCMAGPTR(File 2005 IEN)="
|
---|
| 90 | ^MAGD(2006.79,1,1,82,0)=" ; MCFILE ^ MCD0 ^ MCD1 (IEN of image in image mult)"
|
---|
| 91 | ^MAGD(2006.79,1,1,83,0)=" ; OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
|
---|
| 92 | ^MAGD(2006.79,1,1,84,0)=" N DD,DIC,DINUM,DLAYGO,DO,MCD1,MCDIC,MCMAGD0,MCNODE,X,Y"
|
---|
| 93 | ^MAGD(2006.79,1,1,85,0)=" S OK=""1^The Medicine Procedure file has been updated"""
|
---|
| 94 | ^MAGD(2006.79,1,1,86,0)=" I $O(MCMAGPTR(0))'>0 D Q"
|
---|
| 95 | ^MAGD(2006.79,1,1,87,0)=" . S OK=""0^No image number to file in Medicine Procedure file"""
|
---|
| 96 | ^MAGD(2006.79,1,1,88,0)=" . Q"
|
---|
| 97 | ^MAGD(2006.79,1,1,89,0)=" I $$VFIELD^DILFD(MCFILE,2005)'>0 D Q"
|
---|
| 98 | ^MAGD(2006.79,1,1,90,0)=" . S OK=""0^Image field not found in the Medicine Procedure file"""
|
---|
| 99 | ^MAGD(2006.79,1,1,91,0)=" . Q"
|
---|
| 100 | ^MAGD(2006.79,1,1,92,0)=" S MCNODE=$P($$GET1^DID(MCFILE,2005,"""",""GLOBAL SUBSCRIPT LOCATION""),"";"")"
|
---|
| 101 | ^MAGD(2006.79,1,1,93,0)=" I MCNODE="""" D Q"
|
---|
| 102 | ^MAGD(2006.79,1,1,94,0)=" . S OK=""0^Medicine Procedure file global subscript location not found"""
|
---|
| 103 | ^MAGD(2006.79,1,1,95,0)=" . Q"
|
---|
| 104 | ^MAGD(2006.79,1,1,96,0)=" S MCDIC=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")_MCD0_"","""
|
---|
| 105 | ^MAGD(2006.79,1,1,97,0)=" S MCDIC=MCDIC_$S(MCNODE=+MCNODE:MCNODE,1:""""""""_MCNODE_"""""""")_"","""
|
---|
| 106 | ^MAGD(2006.79,1,1,98,0)=" S MCDIC(""P"")=$$GET1^DID(MCFILE,2005,"""",""SPECIFIER"")"
|
---|
| 107 | ^MAGD(2006.79,1,1,99,0)=" S MCMAGD0=0"
|
---|
| 108 | ^MAGD(2006.79,1,1,100,0)=" F S MCMAGD0=$O(MCMAGPTR(MCMAGD0)) Q:MCMAGD0'>0 D Q:'OK"
|
---|
| 109 | ^MAGD(2006.79,1,1,101,0)=" . S MCD1=+$O(^MCAR(MCFILE,MCD0,MCNODE,""B"",MCMAGD0,0))"
|
---|
| 110 | ^MAGD(2006.79,1,1,102,0)=" . I MCMAGD0'=$P($G(^MCAR(MCFILE,MCD0,MCNODE,MCD1,0)),U) S MCD1=0"
|
---|
| 111 | ^MAGD(2006.79,1,1,103,0)=" . K DD,DIC,DINUM,DO"
|
---|
| 112 | ^MAGD(2006.79,1,1,104,0)=" . S DIC=MCDIC,DIC(0)=""L"",DIC(""P"")=MCDIC(""P"")"
|
---|
| 113 | ^MAGD(2006.79,1,1,105,0)=" . S DLAYGO=MCFILE,(D0,DA(1))=MCD0"
|
---|
| 114 | ^MAGD(2006.79,1,1,106,0)=" . S X=MCMAGD0"
|
---|
| 115 | ^MAGD(2006.79,1,1,107,0)=" . I MCD1'>0 D"
|
---|
| 116 | ^MAGD(2006.79,1,1,108,0)=" .. D FILE^DICN S MCD1=+Y"
|
---|
| 117 | ^MAGD(2006.79,1,1,109,0)=" .. I MCD1'>0 S OK=""0^Cannot add image to Medicine Procedure file"""
|
---|
| 118 | ^MAGD(2006.79,1,1,110,0)=" .. Q"
|
---|
| 119 | ^MAGD(2006.79,1,1,111,0)=" . I OK S MCMAGPTR(MCMAGD0)=MCFILE_U_MCD0_U_MCD1"
|
---|
| 120 | ^MAGD(2006.79,1,1,112,0)=" . Q"
|
---|
| 121 | ^MAGD(2006.79,1,1,113,0)=" Q"
|
---|
| 122 | ^MAGD(2006.79,1,1,114,0)=" ;"
|
---|
| 123 | ^MAGD(2006.79,1,1,115,0)="VALID(FILE,IEN,DFN,PRC) ;"
|
---|
| 124 | ^MAGD(2006.79,1,1,116,0)=" ; *** Make sure we have the right Medicine Procedure data file rec ***"
|
---|
| 125 | ^MAGD(2006.79,1,1,117,0)=" ; FILE = File number of one of the Medicine Procedure data files"
|
---|
| 126 | ^MAGD(2006.79,1,1,118,0)=" ; IEN = Pointer to one of the Medicine Procedure data files"
|
---|
| 127 | ^MAGD(2006.79,1,1,119,0)=" ; DFN = Pointer to the Patient file (#2)"
|
---|
| 128 | ^MAGD(2006.79,1,1,120,0)=" ; PRC = Pointer to the Procedure/Subspecialty file (#697.2)"
|
---|
| 129 | ^MAGD(2006.79,1,1,121,0)=" ; Returns"
|
---|
| 130 | ^MAGD(2006.79,1,1,122,0)=" ; '1^Message' = All is well, '0^Message' = Bad news"
|
---|
| 131 | ^MAGD(2006.79,1,1,123,0)=" N FIELD,OK,TYPE"
|
---|
| 132 | ^MAGD(2006.79,1,1,124,0)=" S OK=""1^Record match found"""
|
---|
| 133 | ^MAGD(2006.79,1,1,125,0)=" S FIELD=$$PATFLD(FILE)"
|
---|
| 134 | ^MAGD(2006.79,1,1,126,0)=" I FIELD,$$GET1^DIQ(FILE,IEN,FIELD,""I"")'=DFN D"
|
---|
| 135 | ^MAGD(2006.79,1,1,127,0)=" . S OK=""0^Patient mismatch"""
|
---|
| 136 | ^MAGD(2006.79,1,1,128,0)=" . Q"
|
---|
| 137 | ^MAGD(2006.79,1,1,129,0)=" S FIELD=$$PRCFLD(FILE),TYPE=$$PRCTYPE(PRC)"
|
---|
| 138 | ^MAGD(2006.79,1,1,130,0)=" ; *** Old Generalized Procedures module and other modules"
|
---|
| 139 | ^MAGD(2006.79,1,1,131,0)=" I (MCFILE'=699.5)!((MCFILE=699.5)&($$VFILE^DILFD(MCFILE,.06)'>0)) D"
|
---|
| 140 | ^MAGD(2006.79,1,1,132,0)=" . S FIELD=$P(FIELD,U)"
|
---|
| 141 | ^MAGD(2006.79,1,1,133,0)=" . Q"
|
---|
| 142 | ^MAGD(2006.79,1,1,134,0)=" ; *** New Generalized Procedures module"
|
---|
| 143 | ^MAGD(2006.79,1,1,135,0)=" I (MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)>0) D"
|
---|
| 144 | ^MAGD(2006.79,1,1,136,0)=" . S FIELD=$S(TYPE=""S"":$P(FIELD,U),TYPE=""P"":$P(FIELD,U,2),1:0)"
|
---|
| 145 | ^MAGD(2006.79,1,1,137,0)=" . Q"
|
---|
| 146 | ^MAGD(2006.79,1,1,138,0)=" I FIELD,$$GET1^DIQ(FILE,IEN,FIELD,""I"")'=PRC D"
|
---|
| 147 | ^MAGD(2006.79,1,1,139,0)=" . S OK=""0^Procedure/Subspecialty mismatch"""
|
---|
| 148 | ^MAGD(2006.79,1,1,140,0)=" . Q"
|
---|
| 149 | ^MAGD(2006.79,1,1,141,0)=" Q OK"
|
---|
| 150 | ^MAGD(2006.79,1,1,142,0)=" ;"
|
---|
| 151 | ^MAGD(2006.79,1,1,143,0)="PRCFLD(FILE) ;"
|
---|
| 152 | ^MAGD(2006.79,1,1,144,0)=" ; *** Procedure/Subspecialty pointer field ***"
|
---|
| 153 | ^MAGD(2006.79,1,1,145,0)=" ; FILE = File number of one of the Medicine Procedure data files"
|
---|
| 154 | ^MAGD(2006.79,1,1,146,0)=" ; Returns"
|
---|
| 155 | ^MAGD(2006.79,1,1,147,0)=" ; The field# in one of the Medicine Procedure data files that points"
|
---|
| 156 | ^MAGD(2006.79,1,1,148,0)=" ; to the Procedure/Subspecialty file (#690) (Zero [0] if not found)"
|
---|
| 157 | ^MAGD(2006.79,1,1,149,0)=" N PRCFLD"
|
---|
| 158 | ^MAGD(2006.79,1,1,150,0)=" S PRCFLD(694)=2,PRCFLD(694.8)=9,PRCFLD(699)=1,PRCFLD(699.5)="".05^.06"""
|
---|
| 159 | ^MAGD(2006.79,1,1,151,0)=" Q $G(PRCFLD(FILE),0)"
|
---|
| 160 | ^MAGD(2006.79,1,1,152,0)=" ;"
|
---|
| 161 | ^MAGD(2006.79,1,1,153,0)="PATFLD(FILE) ;"
|
---|
| 162 | ^MAGD(2006.79,1,1,154,0)=" ; *** Medical Patient pointer field ***"
|
---|
| 163 | ^MAGD(2006.79,1,1,155,0)=" ; FILE = File number of one of the Medicine Procedure data files"
|
---|
| 164 | ^MAGD(2006.79,1,1,156,0)=" ; Returns"
|
---|
| 165 | ^MAGD(2006.79,1,1,157,0)=" ; The field# in one of the Medicine Procedure data files that points"
|
---|
| 166 | ^MAGD(2006.79,1,1,158,0)=" ; to the Medical Patient file (#690) (Zero [0] if not found)"
|
---|
| 167 | ^MAGD(2006.79,1,1,159,0)=" N MEDPAT"
|
---|
| 168 | ^MAGD(2006.79,1,1,160,0)=" S MEDPAT(691)=1,MEDPAT(691.1)=1,MEDPAT(691.5)=1,MEDPAT(691.6)=1"
|
---|
| 169 | ^MAGD(2006.79,1,1,161,0)=" S MEDPAT(691.7)=1,MEDPAT(691.8)=1,MEDPAT(694)=1,MEDPAT(694.5)=1"
|
---|
| 170 | ^MAGD(2006.79,1,1,162,0)=" S MEDPAT(698)=1,MEDPAT(698.1)=1,MEDPAT(698.2)=1,MEDPAT(698.3)=1"
|
---|
| 171 | ^MAGD(2006.79,1,1,163,0)=" S MEDPAT(699)=.02,MEDPAT(699.5)=.02,MEDPAT(700)=1,MEDPAT(701)=1"
|
---|
| 172 | ^MAGD(2006.79,1,1,164,0)=" Q $G(MEDPAT(FILE),0)"
|
---|
| 173 | ^MAGD(2006.79,1,1,165,0)=" ;"
|
---|
| 174 | ^MAGD(2006.79,1,1,166,0)="PRCSUBS ; *** Procedure/Subspecialty DIC(""DR"") builder ***"
|
---|
| 175 | ^MAGD(2006.79,1,1,167,0)=" ; *** Old Generalized Procedures module and other modules"
|
---|
| 176 | ^MAGD(2006.79,1,1,168,0)=" N MCGENPRC,MCGENSUB,MCPRCTYP"
|
---|
| 177 | ^MAGD(2006.79,1,1,169,0)=" I (MCFILE'=699.5)!((MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)'>0)) D"
|
---|
| 178 | ^MAGD(2006.79,1,1,170,0)=" . D PRCTEST(MCFILE,$P(MCPRCFLD,U),MCPROCD0,.OK)"
|
---|
| 179 | ^MAGD(2006.79,1,1,171,0)=" . S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCPROCD0"
|
---|
| 180 | ^MAGD(2006.79,1,1,172,0)=" . Q"
|
---|
| 181 | ^MAGD(2006.79,1,1,173,0)=" ; *** New Generalized Procedures module"
|
---|
| 182 | ^MAGD(2006.79,1,1,174,0)=" I (MCFILE=699.5)&($$VFIELD^DILFD(MCFILE,.06)>0) D"
|
---|
| 183 | ^MAGD(2006.79,1,1,175,0)=" . S MCGENPRC=$$FINDPRC(""GENERIC PROCEDURE"",""P"")"
|
---|
| 184 | ^MAGD(2006.79,1,1,176,0)=" . I MCGENPRC'>0 S OK=""0^Entry 'GENERIC PROCEDURE' not found"" Q"
|
---|
| 185 | ^MAGD(2006.79,1,1,177,0)=" . S MCGENSUB=$$FINDPRC(""GENERIC SUBSPECIALTY"",""S"")"
|
---|
| 186 | ^MAGD(2006.79,1,1,178,0)=" . I MCGENSUB'>0 S OK=""0^Entry 'GENERIC SUBSPECIALTY' not found"" Q"
|
---|
| 187 | ^MAGD(2006.79,1,1,179,0)=" . S MCPRCTYP=$$PRCTYPE(MCPROCD0)"
|
---|
| 188 | ^MAGD(2006.79,1,1,180,0)=" . I ""^P^S^""'[(U_MCPRCTYP_U) S OK=""0^Invalid Procedure/Subspecialty"" Q"
|
---|
| 189 | ^MAGD(2006.79,1,1,181,0)=" . D PRCTEST(MCFILE,$P(MCPRCFLD,U,$TR(MCPRCTYP,""PS"",""21"")),MCPROCD0,.OK)"
|
---|
| 190 | ^MAGD(2006.79,1,1,182,0)=" . I MCPRCTYP=""P"" D"
|
---|
| 191 | ^MAGD(2006.79,1,1,183,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCGENSUB"
|
---|
| 192 | ^MAGD(2006.79,1,1,184,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U,2)_""///`""_MCPROCD0"
|
---|
| 193 | ^MAGD(2006.79,1,1,185,0)=" .. Q"
|
---|
| 194 | ^MAGD(2006.79,1,1,186,0)=" . I MCPRCTYP=""S"" D"
|
---|
| 195 | ^MAGD(2006.79,1,1,187,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U)_""///`""_MCPROCD0"
|
---|
| 196 | ^MAGD(2006.79,1,1,188,0)=" .. S DIC(""DR"")=DIC(""DR"")_"";""_$P(MCPRCFLD,U,2)_""///`""_MCGENPRC"
|
---|
| 197 | ^MAGD(2006.79,1,1,189,0)=" .. Q"
|
---|
| 198 | ^MAGD(2006.79,1,1,190,0)=" . Q"
|
---|
| 199 | ^MAGD(2006.79,1,1,191,0)=" Q"
|
---|
| 200 | ^MAGD(2006.79,1,1,192,0)=" ;"
|
---|
| 201 | ^MAGD(2006.79,1,1,193,0)="PRCTEST(MCFILE,MCPRCFLD,MCPROCD0,OK) ;"
|
---|
| 202 | ^MAGD(2006.79,1,1,194,0)=" ; *** Test for valid procedure"
|
---|
| 203 | ^MAGD(2006.79,1,1,195,0)=" N MCRESULT"
|
---|
| 204 | ^MAGD(2006.79,1,1,196,0)=" D CHK^DIE(MCFILE,MCPRCFLD,"""",""`""_MCPROCD0,.MCRESULT)"
|
---|
| 205 | ^MAGD(2006.79,1,1,197,0)=" K ^TMP(""DIERR"",$J)"
|
---|
| 206 | ^MAGD(2006.79,1,1,198,0)=" I MCRESULT=U S OK=""0^Procedure is invalid"""
|
---|
| 207 | ^MAGD(2006.79,1,1,199,0)=" Q"
|
---|
| 208 | ^MAGD(2006.79,1,1,200,0)=" ;"
|
---|
| 209 | ^MAGD(2006.79,1,1,201,0)="PRCTYPE(MCPROCD0) ;"
|
---|
| 210 | ^MAGD(2006.79,1,1,202,0)=" ; *** Return the procedure type ***"
|
---|
| 211 | ^MAGD(2006.79,1,1,203,0)=" Q $P($G(^MCAR(697.2,MCPROCD0,1)),U)"
|
---|
| 212 | ^MAGD(2006.79,1,1,204,0)=" ;"
|
---|
| 213 | ^MAGD(2006.79,1,1,205,0)="FINDPRC(MCENTRY,MCTYPE) ;"
|
---|
| 214 | ^MAGD(2006.79,1,1,206,0)=" ; *** Find a procedure ***"
|
---|
| 215 | ^MAGD(2006.79,1,1,207,0)=" ; MCENTRY = External name of the entry (697.2,.01)"
|
---|
| 216 | ^MAGD(2006.79,1,1,208,0)=" ; MCTYPE = Internal 'Procedure/Subspecialty' type (697.2,1001)"
|
---|
| 217 | ^MAGD(2006.79,1,1,209,0)=" ; Returns"
|
---|
| 218 | ^MAGD(2006.79,1,1,210,0)=" ; The IEN of the procedure or zero if not found."
|
---|
| 219 | ^MAGD(2006.79,1,1,211,0)=" N MCFOUND,MCIEN"
|
---|
| 220 | ^MAGD(2006.79,1,1,212,0)=" S (MCIEN,MCFOUND)=0"
|
---|
| 221 | ^MAGD(2006.79,1,1,213,0)=" F S MCIEN=$O(^MCAR(697.2,""B"",MCENTRY,MCIEN)) Q:MCIEN'>0 D Q:MCFOUND"
|
---|
| 222 | ^MAGD(2006.79,1,1,214,0)=" . I $P($G(^MCAR(697.2,MCIEN,0)),U)=MCENTRY D"
|
---|
| 223 | ^MAGD(2006.79,1,1,215,0)=" .. I $P($G(^MCAR(697.2,MCIEN,1)),U)=MCTYPE S MCFOUND=1"
|
---|
| 224 | ^MAGD(2006.79,1,1,216,0)=" .. Q"
|
---|
| 225 | ^MAGD(2006.79,1,1,217,0)=" . Q"
|
---|
| 226 | ^MAGD(2006.79,1,1,218,0)=" Q +MCIEN"
|
---|
| 227 | ^MAGD(2006.79,1,1,219,0)=" ;"
|
---|
| 228 | ^MAGD(2006.79,1,1,220,0)="KILL(MCFILE,MCD0,MCD1,OK) ;"
|
---|
| 229 | ^MAGD(2006.79,1,1,221,0)=" ; *** Remove an image from Image multiple ***"
|
---|
| 230 | ^MAGD(2006.79,1,1,222,0)=" ; MCFILE = A Medicine Procedure data file number"
|
---|
| 231 | ^MAGD(2006.79,1,1,223,0)=" ; MCD0 = Pointer to one of the Medicine Procedure data files"
|
---|
| 232 | ^MAGD(2006.79,1,1,224,0)=" ; MCD1 = Pointer to one of the entries in the in the Image multiple"
|
---|
| 233 | ^MAGD(2006.79,1,1,225,0)=" ; OK = A return flag: '1^Message' = All is well, '0^Message' = Bad news"
|
---|
| 234 | ^MAGD(2006.79,1,1,226,0)=" N D0,D1,DA,DIK,MCNODE"
|
---|
| 235 | ^MAGD(2006.79,1,1,227,0)=" S OK=""1^Image pointer deleted from Medicine Procedure file"""
|
---|
| 236 | ^MAGD(2006.79,1,1,228,0)=" I $$VFIELD^DILFD(MCFILE,2005)'>0 D Q"
|
---|
| 237 | ^MAGD(2006.79,1,1,229,0)=" . S OK=""0^Image field not found in the Medicine Procedure file"""
|
---|
| 238 | ^MAGD(2006.79,1,1,230,0)=" . Q"
|
---|
| 239 | ^MAGD(2006.79,1,1,231,0)=" S DIK=$$GET1^DID(MCFILE,"""","""",""GLOBAL NAME"")"
|
---|
| 240 | ^MAGD(2006.79,1,1,232,0)=" I DIK="""" D Q"
|
---|
| 241 | ^MAGD(2006.79,1,1,233,0)=" . S OK=""0^Medicine Procedure file global name not found"""
|
---|
| 242 | ^MAGD(2006.79,1,1,234,0)=" . Q"
|
---|
| 243 | ^MAGD(2006.79,1,1,235,0)=" S MCNODE=$P($$GET1^DID(MCFILE,2005,"""",""GLOBAL SUBSCRIPT LOCATION""),"";"")"
|
---|
| 244 | ^MAGD(2006.79,1,1,236,0)=" I MCNODE="""" D Q"
|
---|
| 245 | ^MAGD(2006.79,1,1,237,0)=" . S OK=""0^Medicine Procedure file global subscript location not found"""
|
---|
| 246 | ^MAGD(2006.79,1,1,238,0)=" . Q"
|
---|
| 247 | ^MAGD(2006.79,1,1,239,0)=" S DIK=DIK_MCD0_"",""_$S(MCNODE=+MCNODE:MCNODE,1:""""""""_MCNODE_"""""""")_"","""
|
---|
| 248 | ^MAGD(2006.79,1,1,240,0)=" S (D0,DA(1))=MCD0,(D1,DA)=MCD1"
|
---|
| 249 | ^MAGD(2006.79,1,1,241,0)=" D ^DIK"
|
---|
| 250 | ^MAGD(2006.79,1,1,242,0)=" Q"
|
---|
| 251 | ^MAGD(2006.79,2,0)="RARIC^3060410.105553"
|
---|
| 252 | ^MAGD(2006.79,2,1,0)="^2006.791^80^80"
|
---|
| 253 | ^MAGD(2006.79,2,1,1,0)="RARIC ;HISC/FPT AISC/SAW-Radiologic Image Capture and Display Routine ;6/19/97 12:06"
|
---|
| 254 | ^MAGD(2006.79,2,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**23,27**;Mar 16, 1998"
|
---|
| 255 | ^MAGD(2006.79,2,1,3,0)=" ;"
|
---|
| 256 | ^MAGD(2006.79,2,1,4,0)="CREATE ; create new stub entry in file 74"
|
---|
| 257 | ^MAGD(2006.79,2,1,5,0)=" ; called from ^MAGKEXC, ^MAGKEXC1"
|
---|
| 258 | ^MAGD(2006.79,2,1,6,0)=" ; If no report entry is created, RARPT will be undefined"
|
---|
| 259 | ^MAGD(2006.79,2,1,7,0)=" K RARPT"
|
---|
| 260 | ^MAGD(2006.79,2,1,8,0)=" ; --------------------------------------------------------------------"
|
---|
| 261 | ^MAGD(2006.79,2,1,9,0)=" ; Perform data validation checks for the following 'RA' namespaced"
|
---|
| 262 | ^MAGD(2006.79,2,1,10,0)=" ; variables: RADTE, RADFN, RADTI, RACN & RACNI (all should be defined)"
|
---|
| 263 | ^MAGD(2006.79,2,1,11,0)=" Q:'$D(RADTE)!('$D(RADFN))!('$D(RADTI))!('$D(RACN))!('$D(RACNI))"
|
---|
| 264 | ^MAGD(2006.79,2,1,12,0)=" ; Check the above variables to insure they consist of the proper"
|
---|
| 265 | ^MAGD(2006.79,2,1,13,0)=" ; sequence of characters."
|
---|
| 266 | ^MAGD(2006.79,2,1,14,0)=" Q:RADTE'?7N1"".""1.4N ; Fileman internal date/time without seconds"
|
---|
| 267 | ^MAGD(2006.79,2,1,15,0)=" K RASULT D DT^DILF(""T"",RADTE,.RASULT)"
|
---|
| 268 | ^MAGD(2006.79,2,1,16,0)=" I RASULT=-1 K RASULT Q ; invalid FM internal date format"
|
---|
| 269 | ^MAGD(2006.79,2,1,17,0)=" K RASULT"
|
---|
| 270 | ^MAGD(2006.79,2,1,18,0)=" Q:RADTI'?7N1"".""1.4N ; reverse chronological date/time without seconds"
|
---|
| 271 | ^MAGD(2006.79,2,1,19,0)=" Q:+RADFN'=RADFN Q:'$D(^RADPT(RADFN,0)) ; not a number, or invalid ien"
|
---|
| 272 | ^MAGD(2006.79,2,1,20,0)=" Q:RACN'?1.5N ; case #'s lie in the range of 1-99999"
|
---|
| 273 | ^MAGD(2006.79,2,1,21,0)=" Q:RACNI'?1N.N ; must be a number, period"
|
---|
| 274 | ^MAGD(2006.79,2,1,22,0)=" Q:'$D(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)) ; exam record missing"
|
---|
| 275 | ^MAGD(2006.79,2,1,23,0)=" Q:$P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),U)'=RACN ; case/exam mismatch"
|
---|
| 276 | ^MAGD(2006.79,2,1,24,0)=" ; --------------------------------------------------------------------"
|
---|
| 277 | ^MAGD(2006.79,2,1,25,0)=" ; continue whether exam was purged or not -- 08/23/00"
|
---|
| 278 | ^MAGD(2006.79,2,1,26,0)=" N RAPRTSET,RAMEMARR,RA1"
|
---|
| 279 | ^MAGD(2006.79,2,1,27,0)=" D EN2^RAUTL20(.RAMEMARR) ; is this case part of a print set ?"
|
---|
| 280 | ^MAGD(2006.79,2,1,28,0)=" ; don't need to lock exam date's node"
|
---|
| 281 | ^MAGD(2006.79,2,1,29,0)=" N I,J,X S I=$P(^RARPT(0),""^"",3)"
|
---|
| 282 | ^MAGD(2006.79,2,1,30,0)="LOCK S I=I+1 L +^RARPT(I):1"
|
---|
| 283 | ^MAGD(2006.79,2,1,31,0)=" I $T,'$D(^RARPT(I)),'$D(^RARPT(""B"",I)) G NEWOK"
|
---|
| 284 | ^MAGD(2006.79,2,1,32,0)=" L -^RARPT(I)"
|
---|
| 285 | ^MAGD(2006.79,2,1,33,0)=" S X=$G(^RAPRT(I,0))"
|
---|
| 286 | ^MAGD(2006.79,2,1,34,0)=" ;"
|
---|
| 287 | ^MAGD(2006.79,2,1,35,0)=" ; if lock-failed node belongs to this case, set rarpt & quit"
|
---|
| 288 | ^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"
|
---|
| 289 | ^MAGD(2006.79,2,1,37,0)=" ; if lock-failed node belongs to a printset with the same patient and "
|
---|
| 290 | ^MAGD(2006.79,2,1,38,0)=" ; exam date/time as the current case, set rarpt & quit"
|
---|
| 291 | ^MAGD(2006.79,2,1,39,0)=" I RAPRTSET,$P(X,""^"",2)=RADFN,(9999999.9999-$P(X,""^"",3))=RADTI S RARPT=I G OUT"
|
---|
| 292 | ^MAGD(2006.79,2,1,40,0)=" ;"
|
---|
| 293 | ^MAGD(2006.79,2,1,41,0)=" G LOCK ; lock-failed node belongs to another case, thus try again"
|
---|
| 294 | ^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"
|
---|
| 295 | ^MAGD(2006.79,2,1,43,0)=" ; don't define ""T"" node"
|
---|
| 296 | ^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"
|
---|
| 297 | ^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"
|
---|
| 298 | ^MAGD(2006.79,2,1,46,0)=" S MAGSCN=$G(^MAG(2006.1,""AXSCN""))"
|
---|
| 299 | ^MAGD(2006.79,2,1,47,0)=" I ('MAGSCN)!(MAGSCN=""N"") S MAGSCN="""""
|
---|
| 300 | ^MAGD(2006.79,2,1,48,0)=" E S MAGSCN=""Images captured for this report."""
|
---|
| 301 | ^MAGD(2006.79,2,1,49,0)=" I $L(MAGSCN) S ^RARPT(RARPT,""R"",0)=""^^1^1^""_DT,^RARPT(RARPT,""R"",1,0)=MAGSCN"
|
---|
| 302 | ^MAGD(2006.79,2,1,50,0)=" ; The orig. clin hist is now referenced directly from file 70, so"
|
---|
| 303 | ^MAGD(2006.79,2,1,51,0)=" ; comment out next 2 lines to stop copying orig. clin hist from file 70"
|
---|
| 304 | ^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)"
|
---|
| 305 | ^MAGD(2006.79,2,1,53,0)=" ;S:J ^RARPT(RARPT,""H"",0)=""^^""_J_""^""_J_""^""_DT"
|
---|
| 306 | ^MAGD(2006.79,2,1,54,0)=" ;Update Activity Log with 'images collected' transaction"
|
---|
| 307 | ^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"
|
---|
| 308 | ^MAGD(2006.79,2,1,56,0)=" S DA=RARPT,DIK=""^RARPT("",RAQUEUED=1 D IX1^DIK ;D:$D(RAMDV) UPSTAT^RAUTL0"
|
---|
| 309 | ^MAGD(2006.79,2,1,57,0)=" N RARPTN S RARPTN=$P(^RARPT(RARPT,0),""^"")"
|
---|
| 310 | ^MAGD(2006.79,2,1,58,0)=" ;"
|
---|
| 311 | ^MAGD(2006.79,2,1,59,0)=" ; create a var RARIC to suppress display of info msg from ptr^rarte2"
|
---|
| 312 | ^MAGD(2006.79,2,1,60,0)=" ; if another case of this printset got cancelled"
|
---|
| 313 | ^MAGD(2006.79,2,1,61,0)=" I RAPRTSET N RARIC S RARIC=1 D PTR^RARTE2"
|
---|
| 314 | ^MAGD(2006.79,2,1,62,0)=" ; don't have to check raxit, since we're quitting now"
|
---|
| 315 | ^MAGD(2006.79,2,1,63,0)=" ;"
|
---|
| 316 | ^MAGD(2006.79,2,1,64,0)=" K DA,DIK,J,RAQUEUED"
|
---|
| 317 | ^MAGD(2006.79,2,1,65,0)="OUT L -^RARPT(RARPT)"
|
---|
| 318 | ^MAGD(2006.79,2,1,66,0)=" Q"
|
---|
| 319 | ^MAGD(2006.79,2,1,67,0)="PTR ; create pointer in file 74 for Imaging package"
|
---|
| 320 | ^MAGD(2006.79,2,1,68,0)=" ; called from MAGKEXC, MAGKEXC1 & MAGRIC"
|
---|
| 321 | ^MAGD(2006.79,2,1,69,0)=" ; input: RARPT - IEN of Rad/NM Report file #74"
|
---|
| 322 | ^MAGD(2006.79,2,1,70,0)=" ; MAGGP - IEN of record in file 2005 pointed to by a report"
|
---|
| 323 | ^MAGD(2006.79,2,1,71,0)=" ; returns: Y=0 - variable MAGGP does not exist"
|
---|
| 324 | ^MAGD(2006.79,2,1,72,0)=" ; Y=-1 - FileMan could not create an entry"
|
---|
| 325 | ^MAGD(2006.79,2,1,73,0)=" ; Y>0 - FileMan created an entry"
|
---|
| 326 | ^MAGD(2006.79,2,1,74,0)=" ;"
|
---|
| 327 | ^MAGD(2006.79,2,1,75,0)=" N DA,DIC"
|
---|
| 328 | ^MAGD(2006.79,2,1,76,0)=" I '$D(MAGGP) S Y=0 Q"
|
---|
| 329 | ^MAGD(2006.79,2,1,77,0)=" S DIC(""P"")=$P(^DD(74,2005,0),U,2)"
|
---|
| 330 | ^MAGD(2006.79,2,1,78,0)=" S DA(1)=RARPT,DIC=""^RARPT(""_DA(1)_"",2005,"",DIC(0)=""LZ"",X=MAGGP"
|
---|
| 331 | ^MAGD(2006.79,2,1,79,0)=" K DD,DO D FILE^DICN"
|
---|
| 332 | ^MAGD(2006.79,2,1,80,0)=" Q"
|
---|
| 333 | ^MAGD(2006.79,3,0)="RARTE2^3060410.105553"
|
---|
| 334 | ^MAGD(2006.79,3,1,0)="^2006.791^126^126"
|
---|
| 335 | ^MAGD(2006.79,3,1,1,0)="RARTE2 ;HISC/SWM-Edit/Delete a Report ;7/16/01 14:05"
|
---|
| 336 | ^MAGD(2006.79,3,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**10,31**;Mar 16, 1998"
|
---|
| 337 | ^MAGD(2006.79,3,1,3,0)=" ; known vars-->RADFN,RACNI,RADTI,RARPT,RARPTN"
|
---|
| 338 | ^MAGD(2006.79,3,1,4,0)="PTR ; if current ^RADPT() rec is a PRINT SET,"
|
---|
| 339 | ^MAGD(2006.79,3,1,5,0)=" ; then for other ^RADPT() recs of the same PRINT SET,"
|
---|
| 340 | ^MAGD(2006.79,3,1,6,0)=" ; create its corresponding subrec in ^RARPT()"
|
---|
| 341 | ^MAGD(2006.79,3,1,7,0)=" S RAXIT=0"
|
---|
| 342 | ^MAGD(2006.79,3,1,8,0)=" I '$D(RADFN)!'$D(RACNI)!'$D(RADTI)!'$D(RARPT)!'$D(RARPTN) D Q"
|
---|
| 343 | ^MAGD(2006.79,3,1,9,0)=" . S RAXIT=1 Q:$G(RARIC)"
|
---|
| 344 | ^MAGD(2006.79,3,1,10,0)=" . I '$D(RAQUIET) W !!,$C(7),""Missing data (routine RARTE2)"",! S RAOUT=$$EOS^RAUTL5() Q"
|
---|
| 345 | ^MAGD(2006.79,3,1,11,0)=" . S RAERR=""Missing data needed by routine RARTE2"""
|
---|
| 346 | ^MAGD(2006.79,3,1,12,0)=" . Q"
|
---|
| 347 | ^MAGD(2006.79,3,1,13,0)=" N RA1,RA2,RA3,RAFDA,RAIEN,RAMSG ;RA3=exam status"
|
---|
| 348 | ^MAGD(2006.79,3,1,14,0)=" S RA1=0"
|
---|
| 349 | ^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"
|
---|
| 350 | ^MAGD(2006.79,3,1,16,0)=" G:RA2=RACNI PTR2 ;skip already processed case"
|
---|
| 351 | ^MAGD(2006.79,3,1,17,0)=" K RAFDA,RAIEN,RAMSG"
|
---|
| 352 | ^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"
|
---|
| 353 | ^MAGD(2006.79,3,1,19,0)=" I $P(^RA(72,+RA3,0),""^"",3)=0 D G:%=2 PTR2 G:%'=1 ASK"
|
---|
| 354 | ^MAGD(2006.79,3,1,20,0)=" . W !!,""Case "",RA1,"" of this print set has been cancelled."""
|
---|
| 355 | ^MAGD(2006.79,3,1,21,0)=" . W !,""Do you want to include it in the report anyway"""
|
---|
| 356 | ^MAGD(2006.79,3,1,22,0)=" . S %=2 D YN^DICN"
|
---|
| 357 | ^MAGD(2006.79,3,1,23,0)=" . W:%>0 ""..."",$S(%=2:""Ex"",%=1:""In"",1:""""),""clude case "",RA1"
|
---|
| 358 | ^MAGD(2006.79,3,1,24,0)=" . Q"
|
---|
| 359 | ^MAGD(2006.79,3,1,25,0)=" ; update file #70, field REPORT TEXT"
|
---|
| 360 | ^MAGD(2006.79,3,1,26,0)="UPD S $P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),U,17)=RARPT"
|
---|
| 361 | ^MAGD(2006.79,3,1,27,0)=" D INSERT"
|
---|
| 362 | ^MAGD(2006.79,3,1,28,0)=" Q:RAXIT G PTR2"
|
---|
| 363 | ^MAGD(2006.79,3,1,29,0)="INSERT ; add subrec to file #74's subfile #74.05"
|
---|
| 364 | ^MAGD(2006.79,3,1,30,0)=" S RAFDA(74.05,""?+2,""_RARPT_"","",.01)=$P(RARPTN,""-"")_""-""_RA1"
|
---|
| 365 | ^MAGD(2006.79,3,1,31,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"")"
|
---|
| 366 | ^MAGD(2006.79,3,1,32,0)=" I $D(RAMSG) D Q"
|
---|
| 367 | ^MAGD(2006.79,3,1,33,0)=" . S RAXIT=1 Q:$G(RARIC)"
|
---|
| 368 | ^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"
|
---|
| 369 | ^MAGD(2006.79,3,1,35,0)=" . S RAERR=""Error encountered while setting sub-recs from RARTE2"""
|
---|
| 370 | ^MAGD(2006.79,3,1,36,0)=" Q"
|
---|
| 371 | ^MAGD(2006.79,3,1,37,0)="DEL17(RAIEN) ;del other print set members' pointer to #74"
|
---|
| 372 | ^MAGD(2006.79,3,1,38,0)=" Q:'$D(RADFN)!('$D(RADTI))"
|
---|
| 373 | ^MAGD(2006.79,3,1,39,0)=" N RA4,RA1 D EN3^RAUTL20(.RA4)"
|
---|
| 374 | ^MAGD(2006.79,3,1,40,0)=" Q:'$O(RA4(0))"
|
---|
| 375 | ^MAGD(2006.79,3,1,41,0)=" S RA1="""""
|
---|
| 376 | ^MAGD(2006.79,3,1,42,0)="D18 S RA1=$O(RA4(RA1)) Q:RA1="""""
|
---|
| 377 | ^MAGD(2006.79,3,1,43,0)=" ; kill xrefs, if any, for file #70's REPORT TEXT"
|
---|
| 378 | ^MAGD(2006.79,3,1,44,0)=" S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
|
---|
| 379 | ^MAGD(2006.79,3,1,45,0)=" ; if this exam's piece 17 doesn't match RAIEN, then don't remove pc17"
|
---|
| 380 | ^MAGD(2006.79,3,1,46,0)=" I $P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,0)),""^"",17)'=RAIEN G D18"
|
---|
| 381 | ^MAGD(2006.79,3,1,47,0)=" D ENKILL^RAXREF(70.03,17,RAIEN,.DA)"
|
---|
| 382 | ^MAGD(2006.79,3,1,48,0)=" ; set REPORT TEXT to null"
|
---|
| 383 | ^MAGD(2006.79,3,1,49,0)=" S:$D(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,0)) $P(^(0),""^"",17)="""""
|
---|
| 384 | ^MAGD(2006.79,3,1,50,0)=" G D18"
|
---|
| 385 | ^MAGD(2006.79,3,1,51,0)="COPY ;copy physicians and diagnoses"
|
---|
| 386 | ^MAGD(2006.79,3,1,52,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAMEMARR))!('$D(RADRS))"
|
---|
| 387 | ^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 ..."",!"
|
---|
| 388 | ^MAGD(2006.79,3,1,54,0)=" N RA1,RA2,RA3"
|
---|
| 389 | ^MAGD(2006.79,3,1,55,0)=" N RA1PR,RA1PS ;prim res/staff"
|
---|
| 390 | ^MAGD(2006.79,3,1,56,0)=" N RA1SR,RA1SS ; sec res/staff arrays--(ien subfile #70.11)=ien file #200"
|
---|
| 391 | ^MAGD(2006.79,3,1,57,0)=" N RA1PD,RA1SD ; prim diag, then sec diags array"
|
---|
| 392 | ^MAGD(2006.79,3,1,58,0)=" N RAFDA,RAIEN,RAMSG"
|
---|
| 393 | ^MAGD(2006.79,3,1,59,0)=" ;prim res, prim staff, prim diag"
|
---|
| 394 | ^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)"
|
---|
| 395 | ^MAGD(2006.79,3,1,61,0)=" ;sec residents"
|
---|
| 396 | ^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)"
|
---|
| 397 | ^MAGD(2006.79,3,1,63,0)=" ;sec staff"
|
---|
| 398 | ^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)"
|
---|
| 399 | ^MAGD(2006.79,3,1,65,0)=" ;sec diagnoses"
|
---|
| 400 | ^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)"
|
---|
| 401 | ^MAGD(2006.79,3,1,67,0)=" ;loop thru other cases of this printset"
|
---|
| 402 | ^MAGD(2006.79,3,1,68,0)=" S RA1=0"
|
---|
| 403 | ^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"
|
---|
| 404 | ^MAGD(2006.79,3,1,70,0)=" ;"
|
---|
| 405 | ^MAGD(2006.79,3,1,71,0)=" ; copy primary staff and resident via Fileman"
|
---|
| 406 | ^MAGD(2006.79,3,1,72,0)=" I RADRS=2 D"
|
---|
| 407 | ^MAGD(2006.79,3,1,73,0)=" . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
|
---|
| 408 | ^MAGD(2006.79,3,1,74,0)=" . S DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","""
|
---|
| 409 | ^MAGD(2006.79,3,1,75,0)=" . S DR=""12////""_RA1PR_"";15////""_RA1PS"
|
---|
| 410 | ^MAGD(2006.79,3,1,76,0)=" . D ^DIE K DA,DIE,DR ; no locking"
|
---|
| 411 | ^MAGD(2006.79,3,1,77,0)=" . Q"
|
---|
| 412 | ^MAGD(2006.79,3,1,78,0)=" ;"
|
---|
| 413 | ^MAGD(2006.79,3,1,79,0)=" ; copy primary diagnostic code via Fileman"
|
---|
| 414 | ^MAGD(2006.79,3,1,80,0)=" I RADRS=1 D"
|
---|
| 415 | ^MAGD(2006.79,3,1,81,0)=" . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1"
|
---|
| 416 | ^MAGD(2006.79,3,1,82,0)=" . S DIE=""^RADPT(""_DA(2)_"",""""DT"""",""_DA(1)_"",""""P"""","""
|
---|
| 417 | ^MAGD(2006.79,3,1,83,0)=" . S DR=""13////""_RA1PD"
|
---|
| 418 | ^MAGD(2006.79,3,1,84,0)=" . D ^DIE K DA,DIE,DR ; no locking"
|
---|
| 419 | ^MAGD(2006.79,3,1,85,0)=" . Q"
|
---|
| 420 | ^MAGD(2006.79,3,1,86,0)=" ;"
|
---|
| 421 | ^MAGD(2006.79,3,1,87,0)=" S RA2=RA1_"",""_RADTI_"",""_RADFN ;stem for dataserver call"
|
---|
| 422 | ^MAGD(2006.79,3,1,88,0)=" S DA(3)=RADFN,DA(2)=RADTI,DA(1)=RA1 ;base vars for DIK call"
|
---|
| 423 | ^MAGD(2006.79,3,1,89,0)=" I RADRS=2 S RA3=0 D KIL3 G:RAXIT Q ; sec res"
|
---|
| 424 | ^MAGD(2006.79,3,1,90,0)=" I RADRS=2 S RA3=0 D KIL4 G:RAXIT Q ; sec staff"
|
---|
| 425 | ^MAGD(2006.79,3,1,91,0)=" I RADRS=1 S RA3=0 D KIL5 G:RAXIT Q ; sec diag"
|
---|
| 426 | ^MAGD(2006.79,3,1,92,0)=" G COPYLOOP"
|
---|
| 427 | ^MAGD(2006.79,3,1,93,0)="KIL3 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""SRR"",RA3)) G:RA3="""" COPY3"
|
---|
| 428 | ^MAGD(2006.79,3,1,94,0)=" S DA=RA3"
|
---|
| 429 | ^MAGD(2006.79,3,1,95,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""SRR"""","""
|
---|
| 430 | ^MAGD(2006.79,3,1,96,0)=" D ^DIK"
|
---|
| 431 | ^MAGD(2006.79,3,1,97,0)=" G KIL3"
|
---|
| 432 | ^MAGD(2006.79,3,1,98,0)="COPY3 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SR(RA3)) Q:'RA3 Q:RAXIT"
|
---|
| 433 | ^MAGD(2006.79,3,1,99,0)="UP3 ;"
|
---|
| 434 | ^MAGD(2006.79,3,1,100,0)=" S RAFDA(70.09,""?+2,""_RA2_"","",.01)=RA1SR(RA3)"
|
---|
| 435 | ^MAGD(2006.79,3,1,101,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY3"
|
---|
| 436 | ^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"
|
---|
| 437 | ^MAGD(2006.79,3,1,103,0)="KIL4 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""SSR"",RA3)) G:RA3="""" COPY4"
|
---|
| 438 | ^MAGD(2006.79,3,1,104,0)=" S DA=RA3"
|
---|
| 439 | ^MAGD(2006.79,3,1,105,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""SSR"""","""
|
---|
| 440 | ^MAGD(2006.79,3,1,106,0)=" D ^DIK"
|
---|
| 441 | ^MAGD(2006.79,3,1,107,0)=" G KIL4"
|
---|
| 442 | ^MAGD(2006.79,3,1,108,0)="COPY4 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SS(RA3)) Q:'RA3 Q:RAXIT"
|
---|
| 443 | ^MAGD(2006.79,3,1,109,0)="UP4 ;"
|
---|
| 444 | ^MAGD(2006.79,3,1,110,0)=" S RAFDA(70.11,""?+2,""_RA2_"","",.01)=RA1SS(RA3)"
|
---|
| 445 | ^MAGD(2006.79,3,1,111,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY4"
|
---|
| 446 | ^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"
|
---|
| 447 | ^MAGD(2006.79,3,1,113,0)="KIL5 S RA3=$O(^RADPT(RADFN,""DT"",RADTI,""P"",RA1,""DX"",RA3)) G:RA3="""" COPY5"
|
---|
| 448 | ^MAGD(2006.79,3,1,114,0)=" S DA=RA3"
|
---|
| 449 | ^MAGD(2006.79,3,1,115,0)=" S DIK=""^RADPT(""_DA(3)_"",""""DT"""",""_DA(2)_"",""""P"""",""_DA(1)_"",""""DX"""","""
|
---|
| 450 | ^MAGD(2006.79,3,1,116,0)=" D ^DIK"
|
---|
| 451 | ^MAGD(2006.79,3,1,117,0)=" G KIL5"
|
---|
| 452 | ^MAGD(2006.79,3,1,118,0)="COPY5 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SD(RA3)) Q:'RA3 Q:RAXIT"
|
---|
| 453 | ^MAGD(2006.79,3,1,119,0)="UP5 ;"
|
---|
| 454 | ^MAGD(2006.79,3,1,120,0)=" S RAFDA(70.14,""?+2,""_RA2_"","",.01)=RA1SD(RA3)"
|
---|
| 455 | ^MAGD(2006.79,3,1,121,0)=" D UPDATE^DIE("""",""RAFDA"",""RAIEN"",""RAMSG"") G:'$D(RAMSG) COPY5"
|
---|
| 456 | ^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"
|
---|
| 457 | ^MAGD(2006.79,3,1,123,0)="COPYREF ; clear out Fileman vars and quit"
|
---|
| 458 | ^MAGD(2006.79,3,1,124,0)=" K DA,DIK"
|
---|
| 459 | ^MAGD(2006.79,3,1,125,0)=" Q ; don't need to re-xref again"
|
---|
| 460 | ^MAGD(2006.79,3,1,126,0)="Q K DA Q"
|
---|
| 461 | ^MAGD(2006.79,4,0)="RAUTL^3060410.105553"
|
---|
| 462 | ^MAGD(2006.79,4,1,0)="^2006.791^101^101"
|
---|
| 463 | ^MAGD(2006.79,4,1,1,0)="RAUTL ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;12/4/97 14:21"
|
---|
| 464 | ^MAGD(2006.79,4,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998"
|
---|
| 465 | ^MAGD(2006.79,4,1,3,0)=" ;"
|
---|
| 466 | ^MAGD(2006.79,4,1,4,0)=" ;Date range selection. Time is allowed if RASKTIME is defined"
|
---|
| 467 | ^MAGD(2006.79,4,1,5,0)=" ;Past date assumed. BEGDATE and ENDDATE are output variables"
|
---|
| 468 | ^MAGD(2006.79,4,1,6,0)="DATE S RAPOP=0 K BEGDATE,ENDDATE W !!,""**** Date Range Selection ****"""
|
---|
| 469 | ^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"
|
---|
| 470 | ^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"
|
---|
| 471 | ^MAGD(2006.79,4,1,9,0)=" Q"
|
---|
| 472 | ^MAGD(2006.79,4,1,10,0)="DATE1 S RAPOP=0 K BEGDATE,ENDDATE W !!,""**** Date Range Selection ****"""
|
---|
| 473 | ^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"
|
---|
| 474 | ^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"
|
---|
| 475 | ^MAGD(2006.79,4,1,13,0)=" Q"
|
---|
| 476 | ^MAGD(2006.79,4,1,14,0)=" ;"
|
---|
| 477 | ^MAGD(2006.79,4,1,15,0)=" ;Generic device/queuing selector"
|
---|
| 478 | ^MAGD(2006.79,4,1,16,0)=" ;RAPOP will be >0 if the job was queued, or if device selection failed"
|
---|
| 479 | ^MAGD(2006.79,4,1,17,0)=" ; $D(RADUPSCN)&$D(RADFLTP) stems from the 'Duplicate Flash Card' option."
|
---|
| 480 | ^MAGD(2006.79,4,1,18,0)="ZIS I '$D(ZTDESC) S ZTDESC=""Rad/Nuc Med ""_$S($D(ZTRTN):ZTRTN,1:""UNKNOWN OPTION"")"
|
---|
| 481 | ^MAGD(2006.79,4,1,19,0)=" S RAMES=$S($D(RAMES):RAMES,1:""W !?5,*7,""""Request Queued."""""")"
|
---|
| 482 | ^MAGD(2006.79,4,1,20,0)=" W ! I $D(RASELDEV) W RASELDEV,! K RASELDEV"
|
---|
| 483 | ^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"
|
---|
| 484 | ^MAGD(2006.79,4,1,22,0)=" G ZIS1:'$D(IO(""Q""))"
|
---|
| 485 | ^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)"
|
---|
| 486 | ^MAGD(2006.79,4,1,24,0)=" D ^%ZTLOAD"
|
---|
| 487 | ^MAGD(2006.79,4,1,25,0)=" I +$G(ZTSK(""D""))>0 X:$D(ZTSK) RAMES W:$D(ZTSK) "" Task #: ""_$G(ZTSK)"
|
---|
| 488 | ^MAGD(2006.79,4,1,26,0)=" K RAMES,ZTDESC,ZTSK,ZTIO,ZTSAVE,ZTRTN,RASV,ZTDTH D HOME^%ZIS S RAPOP=1 Q"
|
---|
| 489 | ^MAGD(2006.79,4,1,27,0)="ZIS1 K RAMES,RASELDEV,ZTDESC,ZTRTN,ZTSAVE Q"
|
---|
| 490 | ^MAGD(2006.79,4,1,28,0)=" ;"
|
---|
| 491 | ^MAGD(2006.79,4,1,29,0)="CLOSE I $D(ZTQUEUED) S ZTREQ=""@"" Q"
|
---|
| 492 | ^MAGD(2006.79,4,1,30,0)=" D ^%ZISC Q"
|
---|
| 493 | ^MAGD(2006.79,4,1,31,0)=" ;"
|
---|
| 494 | ^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"
|
---|
| 495 | ^MAGD(2006.79,4,1,33,0)=" ;"
|
---|
| 496 | ^MAGD(2006.79,4,1,34,0)=" ;called to do some user checks"
|
---|
| 497 | ^MAGD(2006.79,4,1,35,0)=" ;if div param set to ask user instead of auto filing DUZ, prompt for"
|
---|
| 498 | ^MAGD(2006.79,4,1,36,0)=" ; access/verify code"
|
---|
| 499 | ^MAGD(2006.79,4,1,37,0)=" ;if RAKEY is defined, check if user owns this key and set RAPOP=1"
|
---|
| 500 | ^MAGD(2006.79,4,1,38,0)=" ; if user doesn't own key"
|
---|
| 501 | ^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"
|
---|
| 502 | ^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!"""
|
---|
| 503 | ^MAGD(2006.79,4,1,41,0)="USERQ S RAPOP=1 Q"
|
---|
| 504 | ^MAGD(2006.79,4,1,42,0)=" ;"
|
---|
| 505 | ^MAGD(2006.79,4,1,43,0)="DEV ;EXECUTEABLE HELP FOR DEVICE FIELDS IN FILE 79.1 (IMAGING LOCATIONS)"
|
---|
| 506 | ^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!"",!"
|
---|
| 507 | ^MAGD(2006.79,4,1,45,0)=" W !?3,""Device Name:"",?25,""Device Location:"",!?3,""------------"",?25,""----------------"""
|
---|
| 508 | ^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"
|
---|
| 509 | ^MAGD(2006.79,4,1,47,0)=" Q"
|
---|
| 510 | ^MAGD(2006.79,4,1,48,0)=" ;"
|
---|
| 511 | ^MAGD(2006.79,4,1,49,0)="VERIFY ;Ask Access Code"
|
---|
| 512 | ^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"
|
---|
| 513 | ^MAGD(2006.79,4,1,51,0)=" ;"
|
---|
| 514 | ^MAGD(2006.79,4,1,52,0)="A ;Create signature block name using RASIG(""PER"") as input IEN of file 200"
|
---|
| 515 | ^MAGD(2006.79,4,1,53,0)=" ;Write signature to node 20 of file 200"
|
---|
| 516 | ^MAGD(2006.79,4,1,54,0)=" ;(Signature is name in Firstname Lastname format)"
|
---|
| 517 | ^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"
|
---|
| 518 | ^MAGD(2006.79,4,1,56,0)=" ;"
|
---|
| 519 | ^MAGD(2006.79,4,1,57,0)="DUZ ;Lookup and set RASIG(""PER"")=New Person File IFN, set signature block"
|
---|
| 520 | ^MAGD(2006.79,4,1,58,0)=" ;text in File 200 if necessary, set RASIG(""NAME"")=signature block text"
|
---|
| 521 | ^MAGD(2006.79,4,1,59,0)=" S %=1 I $D(DUZ)#2,+DUZ>0,$D(^VA(200,DUZ,0)) S RASIG(""PER"")=DUZ"
|
---|
| 522 | ^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"
|
---|
| 523 | ^MAGD(2006.79,4,1,61,0)=" I '$D(^VA(200,RASIG(""PER""),20)) D A K %INT Q"
|
---|
| 524 | ^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"
|
---|
| 525 | ^MAGD(2006.79,4,1,63,0)=" S RASIG(""NAME"")=$P(^VA(200,RASIG(""PER""),20),""^"",2) K %INT Q"
|
---|
| 526 | ^MAGD(2006.79,4,1,64,0)=" ;"
|
---|
| 527 | ^MAGD(2006.79,4,1,65,0)="SSN(PID,BID,DOD) ;returns full Pt.ID (VA(""PID"")), BID=1 returns VA(""BID"")"
|
---|
| 528 | ^MAGD(2006.79,4,1,66,0)=" ;DOD is defined to internal entry # of eligibility of desired Pt.ID"
|
---|
| 529 | ^MAGD(2006.79,4,1,67,0)=" N DFN"
|
---|
| 530 | ^MAGD(2006.79,4,1,68,0)=" I '$D(RADFN) Q ""Unknown"""
|
---|
| 531 | ^MAGD(2006.79,4,1,69,0)=" S:'$D(BID) BID="""" S:$D(DOD) VAPTYP=DOD"
|
---|
| 532 | ^MAGD(2006.79,4,1,70,0)=" S DFN=RADFN D PID^VADPT6 I VAERR K VAERR Q ""Unknown"""
|
---|
| 533 | ^MAGD(2006.79,4,1,71,0)=" S RASSN=$S(BID:VA(""BID""),1:VA(""PID""))"
|
---|
| 534 | ^MAGD(2006.79,4,1,72,0)=" K VA(""BID""),VA(""PID""),VAERR,VAPTYP"
|
---|
| 535 | ^MAGD(2006.79,4,1,73,0)=" Q RASSN"
|
---|
| 536 | ^MAGD(2006.79,4,1,74,0)="WARNPRC ; send warning if user changes procedure within exam edit"
|
---|
| 537 | ^MAGD(2006.79,4,1,75,0)=" ; and the exam has either or both radiopharms and meds"
|
---|
| 538 | ^MAGD(2006.79,4,1,76,0)=" ; RAY (sub-rec 70.03) comes from rtns RAEDCN or RAEDPT (exam edit)"
|
---|
| 539 | ^MAGD(2006.79,4,1,77,0)=" ; RAPRIT (ien file 71) comes from rtn RASTED (status tracking)"
|
---|
| 540 | ^MAGD(2006.79,4,1,78,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
|
---|
| 541 | ^MAGD(2006.79,4,1,79,0)=" Q:$G(RAY)']""""&('$D(RAPRIT))"
|
---|
| 542 | ^MAGD(2006.79,4,1,80,0)=" N RAMEDS,RADIO,RATAB,RATEXT"
|
---|
| 543 | ^MAGD(2006.79,4,1,81,0)=" S RAMEDS=0,RADIO=0"
|
---|
| 544 | ^MAGD(2006.79,4,1,82,0)=" I $G(RAY)]"""",$P(RAY,U,2)=RAPRI Q ;no change in procedure"
|
---|
| 545 | ^MAGD(2006.79,4,1,83,0)=" I $G(RAPRIT)]"""",RAPRIT=RAPRI Q ;no change in procedure"
|
---|
| 546 | ^MAGD(2006.79,4,1,84,0)=" S RADIO=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),U,28) ;ptr fle #70.2"
|
---|
| 547 | ^MAGD(2006.79,4,1,85,0)=" S RADIO=+$O(^RADPTN(+RADIO,""NUC"",0))"
|
---|
| 548 | ^MAGD(2006.79,4,1,86,0)=" S RAMEDS=+$O(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,""RX"",0))"
|
---|
| 549 | ^MAGD(2006.79,4,1,87,0)=" S RAWHICH=0 ;first assume neither radiopharm nor meds"
|
---|
| 550 | ^MAGD(2006.79,4,1,88,0)=" I 'RAMEDS,RADIO S RAWHICH=1 ;radiopharm only"
|
---|
| 551 | ^MAGD(2006.79,4,1,89,0)=" I RAMEDS,'RADIO S RAWHICH=2 ;meds only"
|
---|
| 552 | ^MAGD(2006.79,4,1,90,0)=" I RAMEDS,RADIO S RAWHICH=3 ;both radiopharm and meds"
|
---|
| 553 | ^MAGD(2006.79,4,1,91,0)=" G:'RAWHICH WARN0"
|
---|
| 554 | ^MAGD(2006.79,4,1,92,0)=" W !!?2,""**"",?21,""Since you have changed the procedure,"",?76,""**"""
|
---|
| 555 | ^MAGD(2006.79,4,1,93,0)=" S RATAB=$S(RAWHICH=1:26,RAWHICH=2:34,1:21)"
|
---|
| 556 | ^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,""**"""
|
---|
| 557 | ^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"
|
---|
| 558 | ^MAGD(2006.79,4,1,96,0)=" W !?2,""**"",?RATAB,RATEXT,?76,""**"""
|
---|
| 559 | ^MAGD(2006.79,4,1,97,0)=" W !?2,""**"",?30,""will now be deleted."",?76,""**"",!,*7"
|
---|
| 560 | ^MAGD(2006.79,4,1,98,0)=" Q"
|
---|
| 561 | ^MAGD(2006.79,4,1,99,0)="WARN0 W !!?2,""**"",?17,""You have changed the procedure, but there are"",?76,""**"""
|
---|
| 562 | ^MAGD(2006.79,4,1,100,0)=" W !?2,""**"",?14,""no data for Radiopharmaceuticals and Meds to delete."",?76,""**"",*7,!"
|
---|
| 563 | ^MAGD(2006.79,4,1,101,0)=" Q"
|
---|
| 564 | ^MAGD(2006.79,5,0)="RAUTL1^3060410.105553"
|
---|
| 565 | ^MAGD(2006.79,5,1,0)="^2006.791^151^151"
|
---|
| 566 | ^MAGD(2006.79,5,1,1,0)="RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;10/22/97 13:54"
|
---|
| 567 | ^MAGD(2006.79,5,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**5,9,18**;Mar 16, 1998"
|
---|
| 568 | ^MAGD(2006.79,5,1,3,0)=" ;last midification by SS for P18 June 19,00"
|
---|
| 569 | ^MAGD(2006.79,5,1,4,0)=" I ""IOSCR""'[X!(X="""") S X=""Unknown"" Q"
|
---|
| 570 | ^MAGD(2006.79,5,1,5,0)=" G @($E(X))"
|
---|
| 571 | ^MAGD(2006.79,5,1,6,0)=" ;Set X=Inpatient Location"
|
---|
| 572 | ^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"")"
|
---|
| 573 | ^MAGD(2006.79,5,1,8,0)=" Q"
|
---|
| 574 | ^MAGD(2006.79,5,1,9,0)=" ;"
|
---|
| 575 | ^MAGD(2006.79,5,1,10,0)=" ;Set X=Outpatient Location"
|
---|
| 576 | ^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"")"
|
---|
| 577 | ^MAGD(2006.79,5,1,12,0)=" Q"
|
---|
| 578 | ^MAGD(2006.79,5,1,13,0)=" ;"
|
---|
| 579 | ^MAGD(2006.79,5,1,14,0)=" ;Set X=Contract/Sharing Agreement patient location"
|
---|
| 580 | ^MAGD(2006.79,5,1,15,0)="S ;"
|
---|
| 581 | ^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"")"
|
---|
| 582 | ^MAGD(2006.79,5,1,17,0)=" Q"
|
---|
| 583 | ^MAGD(2006.79,5,1,18,0)=" ;"
|
---|
| 584 | ^MAGD(2006.79,5,1,19,0)=" ;Set X=Research patient location"
|
---|
| 585 | ^MAGD(2006.79,5,1,20,0)="R S X=$S($D(^RADPT(D0,""DT"",D1,""P"",D2,""R"")):$P(^(""R""),""^""),1:""Unknown"") Q"
|
---|
| 586 | ^MAGD(2006.79,5,1,21,0)=" ;"
|
---|
| 587 | ^MAGD(2006.79,5,1,22,0)=" ;Set X=time of day in external format (ex: 2:28 PM)"
|
---|
| 588 | ^MAGD(2006.79,5,1,23,0)="NOW S %=$P($H,"","",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) D TIME"
|
---|
| 589 | ^MAGD(2006.79,5,1,24,0)=" Q"
|
---|
| 590 | ^MAGD(2006.79,5,1,25,0)=" ;Input X=FM date/time, Output X=time (external format)"
|
---|
| 591 | ^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)"
|
---|
| 592 | ^MAGD(2006.79,5,1,27,0)=" Q"
|
---|
| 593 | ^MAGD(2006.79,5,1,28,0)=" ;"
|
---|
| 594 | ^MAGD(2006.79,5,1,29,0)="ELAPSED ;Pass parameters X (from date) and X1 (to date)"
|
---|
| 595 | ^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"
|
---|
| 596 | ^MAGD(2006.79,5,1,31,0)=" ;Variable Y1 is returned as the # of minutes of elapsed time"
|
---|
| 597 | ^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"
|
---|
| 598 | ^MAGD(2006.79,5,1,33,0)=" X RAMTIME S Y1=X I X<0 S Y=""Neg. Time"" G Q"
|
---|
| 599 | ^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)"
|
---|
| 600 | ^MAGD(2006.79,5,1,35,0)="Q K RAX,X Q"
|
---|
| 601 | ^MAGD(2006.79,5,1,36,0)=" ;"
|
---|
| 602 | ^MAGD(2006.79,5,1,37,0)="UPDATE ;Entry point for Update Rad/Nuc Med Exam Status option"
|
---|
| 603 | ^MAGD(2006.79,5,1,38,0)=" I $O(RACCESS(DUZ,""""))="""" D SETVARS^RAPSET1(0)"
|
---|
| 604 | ^MAGD(2006.79,5,1,39,0)=" I $G(RAIMGTY)="""" D SETVARS^RAPSET1(1)"
|
---|
| 605 | ^MAGD(2006.79,5,1,40,0)=" I $G(RAIMGTY)="""" K XQUIT Q ; didn't sign-on to an imaging location"
|
---|
| 606 | ^MAGD(2006.79,5,1,41,0)=" D ^RACNLU G UPQ:""^""[X"
|
---|
| 607 | ^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"
|
---|
| 608 | ^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"
|
---|
| 609 | ^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"
|
---|
| 610 | ^MAGD(2006.79,5,1,45,0)=" D UP1 I RAOR>0 D"
|
---|
| 611 | ^MAGD(2006.79,5,1,46,0)=" .L +^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
|
---|
| 612 | ^MAGD(2006.79,5,1,47,0)=" .N RAIEN"
|
---|
| 613 | ^MAGD(2006.79,5,1,48,0)=" .S RAIENS=""+1,""_RACNI_"",""_RADTI_"",""_RADFN_"","""
|
---|
| 614 | ^MAGD(2006.79,5,1,49,0)=" .S RAFDA(70.07,RAIENS,.01)=""NOW"""
|
---|
| 615 | ^MAGD(2006.79,5,1,50,0)=" .K RAERR D UPDATE^DIE(""E"",""RAFDA"",""RAIEN"",""RAERR"")"
|
---|
| 616 | ^MAGD(2006.79,5,1,51,0)=" .K RAFDA,RAIENS"
|
---|
| 617 | ^MAGD(2006.79,5,1,52,0)=" .I $D(RAERR) L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI) K RAIEN Q"
|
---|
| 618 | ^MAGD(2006.79,5,1,53,0)=" .S RAIENS=RAIEN(1)_"",""_RACNI_"",""_RADTI_"",""_RADFN_"","""
|
---|
| 619 | ^MAGD(2006.79,5,1,54,0)=" .S RAFDA(70.07,RAIENS,2)=""U"""
|
---|
| 620 | ^MAGD(2006.79,5,1,55,0)=" .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)"
|
---|
| 621 | ^MAGD(2006.79,5,1,56,0)=" .D FILE^DIE(,""RAFDA"")"
|
---|
| 622 | ^MAGD(2006.79,5,1,57,0)=" .L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
|
---|
| 623 | ^MAGD(2006.79,5,1,58,0)="UPQ K RAFDA,RAIENS"
|
---|
| 624 | ^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"
|
---|
| 625 | ^MAGD(2006.79,5,1,60,0)=" ;"
|
---|
| 626 | ^MAGD(2006.79,5,1,61,0)=" ;Exam status updating and accompanying updates to status log, oe/rr"
|
---|
| 627 | ^MAGD(2006.79,5,1,62,0)="UP1 N RA8 S RA8=0 ;use this to flag when one alert has been sent"
|
---|
| 628 | ^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"
|
---|
| 629 | ^MAGD(2006.79,5,1,64,0)=" ; RA EDITCN and RA EDITPT should process this case only"
|
---|
| 630 | ^MAGD(2006.79,5,1,65,0)=" I $D(RAOPT(""EDITCN""))!($D(RAOPT(""EDITPT""))) D UP2,UPK Q"
|
---|
| 631 | ^MAGD(2006.79,5,1,66,0)=" ; see if this case belongs to a printset"
|
---|
| 632 | ^MAGD(2006.79,5,1,67,0)=" N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR"
|
---|
| 633 | ^MAGD(2006.79,5,1,68,0)=" D EN2^RAUTL20(.RAMEMARR) ;043099 always recalculate RAPRTSET"
|
---|
| 634 | ^MAGD(2006.79,5,1,69,0)=" ; if not print set, then just process this case only"
|
---|
| 635 | ^MAGD(2006.79,5,1,70,0)=" I 'RAPRTSET D UP2,UPK Q"
|
---|
| 636 | ^MAGD(2006.79,5,1,71,0)=" ;case belongs to print set, so process all members of same print set"
|
---|
| 637 | ^MAGD(2006.79,5,1,72,0)=" N RACNISAV,RA7"
|
---|
| 638 | ^MAGD(2006.79,5,1,73,0)=" S RACNISAV=RACNI,RA7=0"
|
---|
| 639 | ^MAGD(2006.79,5,1,74,0)=" F S RA7=$O(RAMEMARR(RA7)) Q:RA7="""" S RACNI=RA7 D UP2"
|
---|
| 640 | ^MAGD(2006.79,5,1,75,0)=" S RACNI=RACNISAV"
|
---|
| 641 | ^MAGD(2006.79,5,1,76,0)=" G UPK"
|
---|
| 642 | ^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"""","""
|
---|
| 643 | ^MAGD(2006.79,5,1,78,0)=" N RAAFTER,RABEFORE"
|
---|
| 644 | ^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"
|
---|
| 645 | ^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)"
|
---|
| 646 | ^MAGD(2006.79,5,1,81,0)=" ; S DR=""3////""_RASTI_$S($P(RAMDV,""^"",10):"";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())"",1:"""")"
|
---|
| 647 | ^MAGD(2006.79,5,1,82,0)=" ; user duz could be in RADUZ, if session is from the Voice recognition"
|
---|
| 648 | ^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)"
|
---|
| 649 | ^MAGD(2006.79,5,1,84,0)=" ;D ^DIE"
|
---|
| 650 | ^MAGD(2006.79,5,1,85,0)=" L +^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
|
---|
| 651 | ^MAGD(2006.79,5,1,86,0)=" N RAIEN"
|
---|
| 652 | ^MAGD(2006.79,5,1,87,0)=" S RAIENS=RACNI_"",""_RADTI_"",""_RADFN_"","""
|
---|
| 653 | ^MAGD(2006.79,5,1,88,0)=" S RAFDA(70.03,RAIENS,3)=RASTI"
|
---|
| 654 | ^MAGD(2006.79,5,1,89,0)=" K RAERR D FILE^DIE(,""RAFDA"",""RAERR"")"
|
---|
| 655 | ^MAGD(2006.79,5,1,90,0)=" I $D(RAERR) L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI) G UP2K ;L - P18"
|
---|
| 656 | ^MAGD(2006.79,5,1,91,0)=" I $P(RAMDV,""^"",10) D"
|
---|
| 657 | ^MAGD(2006.79,5,1,92,0)=" .S RAIENS=""+1,""_RACNI_"",""_RADTI_"",""_RADFN_"","""
|
---|
| 658 | ^MAGD(2006.79,5,1,93,0)=" .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT())"
|
---|
| 659 | ^MAGD(2006.79,5,1,94,0)=" .D UPDATE^DIE(,""RAFDA"",""RAIEN"")"
|
---|
| 660 | ^MAGD(2006.79,5,1,95,0)=" .K RAFDA,RAIENS"
|
---|
| 661 | ^MAGD(2006.79,5,1,96,0)=" .Q:'$D(RAIEN(1))"
|
---|
| 662 | ^MAGD(2006.79,5,1,97,0)=" .I $P(RAMDV,""^"",11),('$D(ZTQUEUED)) D"
|
---|
| 663 | ^MAGD(2006.79,5,1,98,0)=" ..S DIE=DIE_RACNI_"",""""T"""","",DA=RAIEN(1)"
|
---|
| 664 | ^MAGD(2006.79,5,1,99,0)=" ..S DR="".01"""
|
---|
| 665 | ^MAGD(2006.79,5,1,100,0)=" ..D ^DIE"
|
---|
| 666 | ^MAGD(2006.79,5,1,101,0)=" .S RAIENS=RAIEN(1)_"",""_RACNI_"",""_RADTI_"",""_RADFN_"","""
|
---|
| 667 | ^MAGD(2006.79,5,1,102,0)=" .S RAFDA(70.05,RAIENS,2)=RASTI"
|
---|
| 668 | ^MAGD(2006.79,5,1,103,0)=" .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ)"
|
---|
| 669 | ^MAGD(2006.79,5,1,104,0)=" .K RAERR2 D FILE^DIE(,""RAFDA"")"
|
---|
| 670 | ^MAGD(2006.79,5,1,105,0)=" L -^RADPT(RADFN,""DT"",RADTI,""P"",RACNI)"
|
---|
| 671 | ^MAGD(2006.79,5,1,106,0)=" ;"
|
---|
| 672 | ^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"
|
---|
| 673 | ^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"
|
---|
| 674 | ^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"
|
---|
| 675 | ^MAGD(2006.79,5,1,110,0)=" I $P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),U,30)="""" D EXM^RAHLRPC"
|
---|
| 676 | ^MAGD(2006.79,5,1,111,0)=" K RACS,RAORDIFN,RAPRIT,RAF5"
|
---|
| 677 | ^MAGD(2006.79,5,1,112,0)=" Q"
|
---|
| 678 | ^MAGD(2006.79,5,1,113,0)="UPK K ORIFN,ORVP,ORNOTE,ORBPMSG,RACS,RAORDIFN,RAPRIT,RAF5"
|
---|
| 679 | ^MAGD(2006.79,5,1,114,0)=" Q"
|
---|
| 680 | ^MAGD(2006.79,5,1,115,0)="OERR ;Send Alert to OERR after pt examined"
|
---|
| 681 | ^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"
|
---|
| 682 | ^MAGD(2006.79,5,1,117,0)=" Q"
|
---|
| 683 | ^MAGD(2006.79,5,1,118,0)="OERR3 ; Send RADIOLOGY PATIENT EXAMINED notification via oe/rr v3"
|
---|
| 684 | ^MAGD(2006.79,5,1,119,0)=" ; Called from UP1"
|
---|
| 685 | ^MAGD(2006.79,5,1,120,0)=" ;"
|
---|
| 686 | ^MAGD(2006.79,5,1,121,0)=" ; RADFN,RADTI,RACNI,RAPRIT must be defined"
|
---|
| 687 | ^MAGD(2006.79,5,1,122,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAPRIT))"
|
---|
| 688 | ^MAGD(2006.79,5,1,123,0)=" ;"
|
---|
| 689 | ^MAGD(2006.79,5,1,124,0)=" N RAIENS,RAMSG,RAOIFN,RAOSTS,RAONODE,RADPTNDE,RAREQPHY"
|
---|
| 690 | ^MAGD(2006.79,5,1,125,0)=" S RADPTNDE=$G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))"
|
---|
| 691 | ^MAGD(2006.79,5,1,126,0)=" S RAOIFN=$P(RADPTNDE,U,11) Q:'RAOIFN ;file 75.1 ien"
|
---|
| 692 | ^MAGD(2006.79,5,1,127,0)=" S RAONODE=$G(^RAO(75.1,+RAOIFN,0))"
|
---|
| 693 | ^MAGD(2006.79,5,1,128,0)=" S RAOSTS=$P(RAONODE,U,5) Q:RAOSTS'=6 ;active exams only"
|
---|
| 694 | ^MAGD(2006.79,5,1,129,0)=" S RAOIFN=$P(RAONODE,U,7) ;file 100 ien"
|
---|
| 695 | ^MAGD(2006.79,5,1,130,0)=" S RAREQPHY=+$P(RADPTNDE,U,14) ;ordering provider"
|
---|
| 696 | ^MAGD(2006.79,5,1,131,0)=" S RAREQPHY(RAREQPHY)="""""
|
---|
| 697 | ^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)"
|
---|
| 698 | ^MAGD(2006.79,5,1,133,0)=" S RAIENS=RADTI_""~""_RACNI"
|
---|
| 699 | ^MAGD(2006.79,5,1,134,0)=" ;"
|
---|
| 700 | ^MAGD(2006.79,5,1,135,0)=" ; oe parameters:"
|
---|
| 701 | ^MAGD(2006.79,5,1,136,0)=" ; ORN: notification id (#100.9 ien)"
|
---|
| 702 | ^MAGD(2006.79,5,1,137,0)=" ; | ORBDFN: patient id (#2 ien)"
|
---|
| 703 | ^MAGD(2006.79,5,1,138,0)=" ; | | ORNUM: order number (#100 ien)"
|
---|
| 704 | ^MAGD(2006.79,5,1,139,0)=" ; | | | ORBADUZ: recipient array"
|
---|
| 705 | ^MAGD(2006.79,5,1,140,0)=" ; | | | | ORBPMSG: message text"
|
---|
| 706 | ^MAGD(2006.79,5,1,141,0)=" ; | | | | | ORBPDATA exam dt~case iens"
|
---|
| 707 | ^MAGD(2006.79,5,1,142,0)=" ; | | | | | |"
|
---|
| 708 | ^MAGD(2006.79,5,1,143,0)=" D EN^ORB3(21,RADFN,RAOIFN,.RAREQPHY,RAMSG,RAIENS)"
|
---|
| 709 | ^MAGD(2006.79,5,1,144,0)=" Q"
|
---|
| 710 | ^MAGD(2006.79,5,1,145,0)=" ;"
|
---|
| 711 | ^MAGD(2006.79,5,1,146,0)=" ;Called by many report programs. Sets RACRT() array containing all"
|
---|
| 712 | ^MAGD(2006.79,5,1,147,0)=" ;exam statuses that are to be included on the report. RACRT is set"
|
---|
| 713 | ^MAGD(2006.79,5,1,148,0)=" ;to the piece of the Exam Status File #72 record that corresponds"
|
---|
| 714 | ^MAGD(2006.79,5,1,149,0)=" ;to the report being generated."
|
---|
| 715 | ^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)="""""
|
---|
| 716 | ^MAGD(2006.79,5,1,151,0)=" Q"
|
---|
| 717 | ^MAGD(2006.79,6,0)="RAUTL2^3060410.105553"
|
---|
| 718 | ^MAGD(2006.79,6,1,0)="^2006.791^142^142"
|
---|
| 719 | ^MAGD(2006.79,6,1,1,0)="RAUTL2 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;11/10/97 11:18"
|
---|
| 720 | ^MAGD(2006.79,6,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**10,26,45**;Mar 16, 1998"
|
---|
| 721 | ^MAGD(2006.79,6,1,3,0)=" ;"
|
---|
| 722 | ^MAGD(2006.79,6,1,4,0)=" ;Called from many points within Rad/Nuc Med package ;ch"
|
---|
| 723 | ^MAGD(2006.79,6,1,5,0)=" ;INPUT VARIABLES: Y=IEN of Rad Report file #74"
|
---|
| 724 | ^MAGD(2006.79,6,1,6,0)=" ; XRT0,XRT1 If set, will do some response time checks"
|
---|
| 725 | ^MAGD(2006.79,6,1,7,0)=" ;OUTPUT VARIABLES:"
|
---|
| 726 | ^MAGD(2006.79,6,1,8,0)=" ; RADFN=Patient DFN, RADTE=Exam date/time (FM format), "
|
---|
| 727 | ^MAGD(2006.79,6,1,9,0)=" ; RACN=long case number, RADTI=reverse exam date/time,"
|
---|
| 728 | ^MAGD(2006.79,6,1,10,0)=" ; RACNI=short case number, RADATE=Exam date/time (external format)"
|
---|
| 729 | ^MAGD(2006.79,6,1,11,0)=" ; Y=If active case, zeroeth node of case record in file #70"
|
---|
| 730 | ^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"
|
---|
| 731 | ^MAGD(2006.79,6,1,13,0)=" S Y="""" I RACNI,$D(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)) S Y=^(0)"
|
---|
| 732 | ^MAGD(2006.79,6,1,14,0)=" I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV"
|
---|
| 733 | ^MAGD(2006.79,6,1,15,0)=" Q"
|
---|
| 734 | ^MAGD(2006.79,6,1,16,0)=" ;"
|
---|
| 735 | ^MAGD(2006.79,6,1,17,0)=" ;Called from 2 x-refs on file #74, Rpt Status fld 5 ;ch"
|
---|
| 736 | ^MAGD(2006.79,6,1,18,0)=" ;Does sets and kills for 'ARES', and 'ASTF' xrefs"
|
---|
| 737 | ^MAGD(2006.79,6,1,19,0)=" ; ** CAUTION ** 1st RARAD=12 or 15, 2nd RARAD=ien for file 200"
|
---|
| 738 | ^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"
|
---|
| 739 | ^MAGD(2006.79,6,1,21,0)=" S RARADOLD=RARAD ;save 1st value of rarad"
|
---|
| 740 | ^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"
|
---|
| 741 | ^MAGD(2006.79,6,1,23,0)=" ; ** CAUTION ** next line is reached 2 ways : from line above,"
|
---|
| 742 | ^MAGD(2006.79,6,1,24,0)=" ; and also from file 70.03, fld 15's ""ASTF"" xref"
|
---|
| 743 | ^MAGD(2006.79,6,1,25,0)=" ; thus RARAD's 2nd meaning must be preserved for XREF1"
|
---|
| 744 | ^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"
|
---|
| 745 | ^MAGD(2006.79,6,1,27,0)="Q K RADA,RADFNZ,RADTIZ,RACNIZ,RARADOLD Q"
|
---|
| 746 | ^MAGD(2006.79,6,1,28,0)=" ;"
|
---|
| 747 | ^MAGD(2006.79,6,1,29,0)=" ;Checks for CONTRAST MEDIA given the necessary subscripts"
|
---|
| 748 | ^MAGD(2006.79,6,1,30,0)=" ;to access a record in File #70."
|
---|
| 749 | ^MAGD(2006.79,6,1,31,0)=" ;RADFN, RADTI, RACNI must be set."
|
---|
| 750 | ^MAGD(2006.79,6,1,32,0)=" ;Output is Y=a string delimited by commas containing all"
|
---|
| 751 | ^MAGD(2006.79,6,1,33,0)=" ;applicable items in externally formatted text (ex: If exam was"
|
---|
| 752 | ^MAGD(2006.79,6,1,34,0)=" ;done with contrast media Y=""CONTRAST MEDIA USED"""
|
---|
| 753 | ^MAGD(2006.79,6,1,35,0)=" ;06/16/99 remove obsolete RAF2"
|
---|
| 754 | ^MAGD(2006.79,6,1,36,0)=" ; add CPT Modifiers string"
|
---|
| 755 | ^MAGD(2006.79,6,1,37,0)=" ; output Y = procedure modifiers string"
|
---|
| 756 | ^MAGD(2006.79,6,1,38,0)=" ; Y(1)= CPT modifiers string, external"
|
---|
| 757 | ^MAGD(2006.79,6,1,39,0)=" ; Y(2)= CPT modifiers string, internal"
|
---|
| 758 | ^MAGD(2006.79,6,1,40,0)="MODS ;get procedure modifiers"
|
---|
| 759 | ^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)"
|
---|
| 760 | ^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"
|
---|
| 761 | ^MAGD(2006.79,6,1,43,0)=" S:$P(X,""^"",10)[""Y"" X1=""CONTRAST MEDIA USED"""
|
---|
| 762 | ^MAGD(2006.79,6,1,44,0)=" ;"
|
---|
| 763 | ^MAGD(2006.79,6,1,45,0)="MODS0 ;falls through from MODS; get CPT modifiers"
|
---|
| 764 | ^MAGD(2006.79,6,1,46,0)=" S:Y="""" Y=""None"""
|
---|
| 765 | ^MAGD(2006.79,6,1,47,0)=" S X=^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),I=0"
|
---|
| 766 | ^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,""^"")"
|
---|
| 767 | ^MAGD(2006.79,6,1,49,0)=" S:Y(1)="""" Y(1)=""None"""
|
---|
| 768 | ^MAGD(2006.79,6,1,50,0)=" K I,X,X1 Q"
|
---|
| 769 | ^MAGD(2006.79,6,1,51,0)=" ;"
|
---|
| 770 | ^MAGD(2006.79,6,1,52,0)="MODS1 ;builds procedure modifier string (called from MODS above)"
|
---|
| 771 | ^MAGD(2006.79,6,1,53,0)=" S Y=Y_$S(Y="""":"""",1:"", "")_X1 Q"
|
---|
| 772 | ^MAGD(2006.79,6,1,54,0)=" ;"
|
---|
| 773 | ^MAGD(2006.79,6,1,55,0)=" ;called to do some order checks - takes appropriate action if:"
|
---|
| 774 | ^MAGD(2006.79,6,1,56,0)=" ; procedure requested needs Rad/NM physician approval (File 71, fld 11)"
|
---|
| 775 | ^MAGD(2006.79,6,1,57,0)=" ; there are other outstanding orders for this procedure for this pt"
|
---|
| 776 | ^MAGD(2006.79,6,1,58,0)=" ; user is inactivated (file 200, ""I"" node)"
|
---|
| 777 | ^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"
|
---|
| 778 | ^MAGD(2006.79,6,1,60,0)=" S RAS3=+$P(^RAO(75.1,DA,0),""^"")"
|
---|
| 779 | ^MAGD(2006.79,6,1,61,0)="ORDPRC1 Q:'$D(^RAO(75.1,""AP"",RAS3,X)) S RAS4=X,RASCNT=0 K RAX"
|
---|
| 780 | ^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"
|
---|
| 781 | ^MAGD(2006.79,6,1,63,0)=" I $D(RAX),'$D(RAQUIT) D ORDMES1"
|
---|
| 782 | ^MAGD(2006.79,6,1,64,0)=" K:$D(RAX) RAQUIT K RAMSG,RAS3,RAS4,RAS5,RAS6,RASCNT,RAT,RAX Q"
|
---|
| 783 | ^MAGD(2006.79,6,1,65,0)=" ;"
|
---|
| 784 | ^MAGD(2006.79,6,1,66,0)="CHKUSR ; Check if valid user"
|
---|
| 785 | ^MAGD(2006.79,6,1,67,0)=" N RAINADT,RAC"
|
---|
| 786 | ^MAGD(2006.79,6,1,68,0)=" S RAINADT=+$P($G(^VA(200,+$G(DUZ),""PS"")),""^"",4)"
|
---|
| 787 | ^MAGD(2006.79,6,1,69,0)=" S RAC=$O(^VA(200,+$G(DUZ),""RAC"",0))"
|
---|
| 788 | ^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)"
|
---|
| 789 | ^MAGD(2006.79,6,1,71,0)=" Q"
|
---|
| 790 | ^MAGD(2006.79,6,1,72,0)="ORDMES W:'$D(RAX) !!,*7,""The following requests are already on file for this procedure:"",!"
|
---|
| 791 | ^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"
|
---|
| 792 | ^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"""
|
---|
| 793 | ^MAGD(2006.79,6,1,75,0)=" I ""Nn""[$E(RAX) K X S RAPRI=0"
|
---|
| 794 | ^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"
|
---|
| 795 | ^MAGD(2006.79,6,1,77,0)=" Q"
|
---|
| 796 | ^MAGD(2006.79,6,1,78,0)=" ;"
|
---|
| 797 | ^MAGD(2006.79,6,1,79,0)=" ;Called (from RAPSET) to determine if at least one division and at"
|
---|
| 798 | ^MAGD(2006.79,6,1,80,0)=" ;least one location are set up. Can't use pkg unless these are set up."
|
---|
| 799 | ^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)"
|
---|
| 800 | ^MAGD(2006.79,6,1,82,0)=" Q"
|
---|
| 801 | ^MAGD(2006.79,6,1,83,0)=" ;"
|
---|
| 802 | ^MAGD(2006.79,6,1,84,0)="KILLVAR ;This call will clean up possible variables left after execution"
|
---|
| 803 | ^MAGD(2006.79,6,1,85,0)=" ;of the Label print fields in file 78.7"
|
---|
| 804 | ^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"
|
---|
| 805 | ^MAGD(2006.79,6,1,87,0)=" K RASTAFF,RASIGS,RATECH,RACTY,RASIGVES,RAVER,RASIGVS,RASIGVSB,RASIGR,RASERV,RASEX,RAS,RAII,RAFMT,RASV"
|
---|
| 806 | ^MAGD(2006.79,6,1,88,0)=" Q"
|
---|
| 807 | ^MAGD(2006.79,6,1,89,0)=" ;"
|
---|
| 808 | ^MAGD(2006.79,6,1,90,0)="CONTRAST(RAZ71) ;Display the contrast media/medium associated with a Rad/Nuc"
|
---|
| 809 | ^MAGD(2006.79,6,1,91,0)=" ;Med Procedure. Called from: PRC1^RAUTL8 & ALLERGY^RAORD1"
|
---|
| 810 | ^MAGD(2006.79,6,1,92,0)=" ;input: RAZ71=ien of the non-parent procedure in file 71"
|
---|
| 811 | ^MAGD(2006.79,6,1,93,0)=" ;"
|
---|
| 812 | ^MAGD(2006.79,6,1,94,0)=" K RAZCM S RAZ71(0)=$G(^RAMIS(71,RAZ71,0))"
|
---|
| 813 | ^MAGD(2006.79,6,1,95,0)=" S RAZCMU=$P(RAZ71(0),""^"",20) ;is contrast media used?"
|
---|
| 814 | ^MAGD(2006.79,6,1,96,0)=" I RAZCMU'=""Y"" K RAZCMU Q"
|
---|
| 815 | ^MAGD(2006.79,6,1,97,0)=" D GETS^DIQ(71,RAZ71_"","",""125*"",""E"",""RAZCM"")"
|
---|
| 816 | ^MAGD(2006.79,6,1,98,0)=" ; The RAZCM(71.0125,x,.01,""E"") array will be one or more of following"
|
---|
| 817 | ^MAGD(2006.79,6,1,99,0)=" ; values: I:Iodinated contrast, ionic;N:Iodinated contrast, non-ionic"
|
---|
| 818 | ^MAGD(2006.79,6,1,100,0)=" ; L:Gadolinium, C:Cholecystogram;G:Gastrografin;B:Barium"
|
---|
| 819 | ^MAGD(2006.79,6,1,101,0)=" ;"
|
---|
| 820 | ^MAGD(2006.79,6,1,102,0)=" S:$O(RAZCM(71.0125,$C(126)),-1)=$O(RAZCM(71.0125,"""")) RAZTAG=""medium"""
|
---|
| 821 | ^MAGD(2006.79,6,1,103,0)=" S:'$D(RAZTAG)#2 RAZTAG=""media"""
|
---|
| 822 | ^MAGD(2006.79,6,1,104,0)=" S RAPMSG(1)=""************** Patient reaction to contrast ""_RAZTAG_"" *************"""
|
---|
| 823 | ^MAGD(2006.79,6,1,105,0)=" S RAPMSG(2)=$E($P(RAZ71(0),""^""),1,47)_"" uses contrast ""_RAZTAG_"": """
|
---|
| 824 | ^MAGD(2006.79,6,1,106,0)=" S RAPMSG(2,""F"")=""!"",RAZI="""",RAZSUB=$O(RAPMSG($C(32)),-1)"
|
---|
| 825 | ^MAGD(2006.79,6,1,107,0)=" F S RAZI=$O(RAZCM(71.0125,RAZI)) Q:RAZI="""" D"
|
---|
| 826 | ^MAGD(2006.79,6,1,108,0)=" .S:$L($G(RAPMSG(RAZSUB)))+$L(RAZCM(71.0125,RAZI,.01,""E""))>69 RAZSUB=RAZSUB+1"
|
---|
| 827 | ^MAGD(2006.79,6,1,109,0)=" .S RAPMSG(RAZSUB)=$G(RAPMSG(RAZSUB))_RAZCM(71.0125,RAZI,.01,""E"")_"", """
|
---|
| 828 | ^MAGD(2006.79,6,1,110,0)=" .Q"
|
---|
| 829 | ^MAGD(2006.79,6,1,111,0)=" ; The reverse dollar order (R$O) is used to strip off the "", "" string"
|
---|
| 830 | ^MAGD(2006.79,6,1,112,0)=" ; from the last printable subscript containing CM data. I also use the"
|
---|
| 831 | ^MAGD(2006.79,6,1,113,0)=" ; R$O to set my last printable array element to '*'s to box off the"
|
---|
| 832 | ^MAGD(2006.79,6,1,114,0)=" ; warning."
|
---|
| 833 | ^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 "", """
|
---|
| 834 | ^MAGD(2006.79,6,1,116,0)=" S $P(RAPMSG($O(RAPMSG($C(32)),-1)+1),""*"",69)="""",RAPMSG(99)="" """
|
---|
| 835 | ^MAGD(2006.79,6,1,117,0)=" D EN^DDIOL(.RAPMSG)"
|
---|
| 836 | ^MAGD(2006.79,6,1,118,0)=" K RAPMSG,RAZCM,RAZCMU,RAZI,RAZTAG,RAZSUB"
|
---|
| 837 | ^MAGD(2006.79,6,1,119,0)=" Q"
|
---|
| 838 | ^MAGD(2006.79,6,1,120,0)=" ;"
|
---|
| 839 | ^MAGD(2006.79,6,1,121,0)="DELCM(DA) ;Ask the user if he/she is sure that deletion of contrast media"
|
---|
| 840 | ^MAGD(2006.79,6,1,122,0)=" ;is intended. If the user enter '^' exit editng the template"
|
---|
| 841 | ^MAGD(2006.79,6,1,123,0)=" ; input: DA=the ien of the record in file 71"
|
---|
| 842 | ^MAGD(2006.79,6,1,124,0)=" ;output: RAYN=response to 'Are you sure?'; either 'Y', 'N', or '^' "
|
---|
| 843 | ^MAGD(2006.79,6,1,125,0)=" ;Called from the RA PROCEDURE EDIT input template (RA*5*45)"
|
---|
| 844 | ^MAGD(2006.79,6,1,126,0)=" N RAYN W !?3,""*** Deleting all contrast media data associated with this procedure. ***"""
|
---|
| 845 | ^MAGD(2006.79,6,1,127,0)=" F D Q:$L($G(RAYN))"
|
---|
| 846 | ^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"
|
---|
| 847 | ^MAGD(2006.79,6,1,129,0)=" .S:'$T!(RAYN[""^"") RAYN=""^"" Q:RAYN=""^"""
|
---|
| 848 | ^MAGD(2006.79,6,1,130,0)=" .S:RAYN="""" RAYN=""N"" Q:RAYN=""N"""
|
---|
| 849 | ^MAGD(2006.79,6,1,131,0)=" .S RAYN=$$UP^XLFSTR($E(RAYN)) Q:RAYN=""Y""!(RAYN=""N"")"
|
---|
| 850 | ^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"
|
---|
| 851 | ^MAGD(2006.79,6,1,133,0)=" .K RAYN W !?3,""Please enter 'Y' for yes, or 'N' for no."""
|
---|
| 852 | ^MAGD(2006.79,6,1,134,0)=" .Q"
|
---|
| 853 | ^MAGD(2006.79,6,1,135,0)=" ;The user does not want to delete associated cm data or has '^' out of"
|
---|
| 854 | ^MAGD(2006.79,6,1,136,0)=" ;the option. We must reset the CONTRAST MEDIA USED (#20) field back to"
|
---|
| 855 | ^MAGD(2006.79,6,1,137,0)=" ;yes from no."
|
---|
| 856 | ^MAGD(2006.79,6,1,138,0)=" I RAYN'=""Y"" D"
|
---|
| 857 | ^MAGD(2006.79,6,1,139,0)=" .K RAFDA S RAFDA(71,DA_"","",20)=""Y"" D FILE^DIE("""",""RAFDA"")"
|
---|
| 858 | ^MAGD(2006.79,6,1,140,0)=" .K RAFDA Q"
|
---|
| 859 | ^MAGD(2006.79,6,1,141,0)=" Q RAYN"
|
---|
| 860 | ^MAGD(2006.79,6,1,142,0)=" ;"
|
---|
| 861 | ^MAGD(2006.79,7,0)="RAUTL20^3060410.105553"
|
---|
| 862 | ^MAGD(2006.79,7,1,0)="^2006.791^128^128"
|
---|
| 863 | ^MAGD(2006.79,7,1,1,0)="RAUTL20 ;HISC/SWM-Utility Routine ;6/16/97 14:27"
|
---|
| 864 | ^MAGD(2006.79,7,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**5,34**;Mar 16, 1998"
|
---|
| 865 | ^MAGD(2006.79,7,1,3,0)=" ;"
|
---|
| 866 | ^MAGD(2006.79,7,1,4,0)="EN1 ; for displaying + and . during case lookup"
|
---|
| 867 | ^MAGD(2006.79,7,1,5,0)=" S RAPRTSET=0"
|
---|
| 868 | ^MAGD(2006.79,7,1,6,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
|
---|
| 869 | ^MAGD(2006.79,7,1,7,0)=" Q:RADFN=""""!(RADTI="""")!(RACNI="""")"
|
---|
| 870 | ^MAGD(2006.79,7,1,8,0)=" ; output : RAPRTSET=1 : case is part of a combined PRINTset, & flag it"
|
---|
| 871 | ^MAGD(2006.79,7,1,9,0)=" ; RAMEMLOW=1 : case is lowest ien of print set AND flag it"
|
---|
| 872 | ^MAGD(2006.79,7,1,10,0)=" N RA1,RA2,RA3,RA4,RA5,RA6,RA7,RACN S RA1="""",RA3=""A"",RA5=0"
|
---|
| 873 | ^MAGD(2006.79,7,1,11,0)=" S RACN=+$G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0))"
|
---|
| 874 | ^MAGD(2006.79,7,1,12,0)=" S RAMEMLOW=0"
|
---|
| 875 | ^MAGD(2006.79,7,1,13,0)=" S RAPRTSET=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),""^"",25)=2"
|
---|
| 876 | ^MAGD(2006.79,7,1,14,0)=" Q:'RAPRTSET"
|
---|
| 877 | ^MAGD(2006.79,7,1,15,0)=" ; put + infront of lowest ien of case that has MEMBER OF SET = 2"
|
---|
| 878 | ^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"
|
---|
| 879 | ^MAGD(2006.79,7,1,17,0)=" S:RACNI=RA1 RAMEMLOW=1"
|
---|
| 880 | ^MAGD(2006.79,7,1,18,0)=" S RA1="""" F S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1)) Q:RA1="""" D LOOP1"
|
---|
| 881 | ^MAGD(2006.79,7,1,19,0)=" I RA5 S RAPRTSET=0,RAMEMLOW=0 ;don't display if ptrs to #74 differ within set"
|
---|
| 882 | ^MAGD(2006.79,7,1,20,0)=" Q"
|
---|
| 883 | ^MAGD(2006.79,7,1,21,0)="LOOP1 ; RA1= : for-loop var"
|
---|
| 884 | ^MAGD(2006.79,7,1,22,0)=" ; RA2= : (1) ien for 70.03 (2) also, pointer value to file #74"
|
---|
| 885 | ^MAGD(2006.79,7,1,23,0)=" ; RA3= : holds earliest case with pointer value to file #74"
|
---|
| 886 | ^MAGD(2006.79,7,1,24,0)=" ; RA4= : (ienof #70.03)=case number^procedure pointers^ptr #74"
|
---|
| 887 | ^MAGD(2006.79,7,1,25,0)=" ; RA5=0 : all cases in set point to same non-null rarpt() or all null"
|
---|
| 888 | ^MAGD(2006.79,7,1,26,0)=" ; regardless of cancelled status"
|
---|
| 889 | ^MAGD(2006.79,7,1,27,0)=" ; RA5<>0: one or more cases in set point to different rarpt()"
|
---|
| 890 | ^MAGD(2006.79,7,1,28,0)=" ; RA6= : pointer to file #72 examination status"
|
---|
| 891 | ^MAGD(2006.79,7,1,29,0)=" ; RA7=1 : denote call of LOOP1 came from EN2 and not from EN1"
|
---|
| 892 | ^MAGD(2006.79,7,1,30,0)=" S RA2=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1,0))"
|
---|
| 893 | ^MAGD(2006.79,7,1,31,0)=" ; skip rec if it's not part of combined report"
|
---|
| 894 | ^MAGD(2006.79,7,1,32,0)=" Q:$P(^RADPT(RADFN,""DT"",RADTI,""P"",RA2,0),""^"",25)'=2"
|
---|
| 895 | ^MAGD(2006.79,7,1,33,0)=" S:$G(RA7) RA4=RA2,RA4(RA4)=RA1"
|
---|
| 896 | ^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)"
|
---|
| 897 | ^MAGD(2006.79,7,1,35,0)=" ; skip if exm canc'd & exm's pc 17 is null"
|
---|
| 898 | ^MAGD(2006.79,7,1,36,0)=" I $P($G(^RA(72,+RA6,0)),""^"",3)=0,RA2="""" Q"
|
---|
| 899 | ^MAGD(2006.79,7,1,37,0)=" S:RA3=""A"" RA3=RA2"
|
---|
| 900 | ^MAGD(2006.79,7,1,38,0)=" I RA5=0,RA2]"""" S RA5=RA2-RA3"
|
---|
| 901 | ^MAGD(2006.79,7,1,39,0)=" Q"
|
---|
| 902 | ^MAGD(2006.79,7,1,40,0)="EN2(RA4) ; display all print members' procs during report editing/printg"
|
---|
| 903 | ^MAGD(2006.79,7,1,41,0)=" S RAPRTSET=0"
|
---|
| 904 | ^MAGD(2006.79,7,1,42,0)=" Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))"
|
---|
| 905 | ^MAGD(2006.79,7,1,43,0)=" Q:RADFN=""""!(RADTI="""")!(RACNI="""")"
|
---|
| 906 | ^MAGD(2006.79,7,1,44,0)=" ; output : RA4(IEN OF #70.03)=CASE NUMBER^IEN OF #71 (procedure)^ptr #74"
|
---|
| 907 | ^MAGD(2006.79,7,1,45,0)=" ; ^exm stat"
|
---|
| 908 | ^MAGD(2006.79,7,1,46,0)=" ; RAPRTSET = 1 : case is part of a combined PRINTset"
|
---|
| 909 | ^MAGD(2006.79,7,1,47,0)=" N RA1,RA2,RA3,RA5,RA6,RA7 S RA1="""",RA3=""A"",RA5=0,RA7=1"
|
---|
| 910 | ^MAGD(2006.79,7,1,48,0)=" F S RA1=$O(RA4(RA1)) Q:RA1="""" K RA4(RA1) ;clean up array"
|
---|
| 911 | ^MAGD(2006.79,7,1,49,0)=" S RAPRTSET=$P($G(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0)),""^"",25)=2"
|
---|
| 912 | ^MAGD(2006.79,7,1,50,0)=" Q:'RAPRTSET"
|
---|
| 913 | ^MAGD(2006.79,7,1,51,0)=" F S RA1=$O(^RADPT(RADFN,""DT"",RADTI,""P"",""B"",RA1)) Q:RA1="""" D LOOP1"
|
---|
| 914 | ^MAGD(2006.79,7,1,52,0)=" I RA5 S RAPRTSET=0 ;don't display if ptrs to #74 differ within set"
|
---|
| 915 | ^MAGD(2006.79,7,1,53,0)=" Q"
|
---|
| 916 | ^MAGD(2006.79,7,1,54,0)="EN3(RA4) ; for print set, AFTER record is created in rarpt()"
|
---|
| 917 | ^MAGD(2006.79,7,1,55,0)=" Q:'$D(RADFN)!('$D(RADTI))"
|
---|
| 918 | ^MAGD(2006.79,7,1,56,0)=" Q:RADFN=""""!(RADTI="""")"
|
---|
| 919 | ^MAGD(2006.79,7,1,57,0)=" ; output :RA4(IEN OF #70.03)=CASE NUMBER (ONLY THOSE CASES FROM #74.05)"
|
---|
| 920 | ^MAGD(2006.79,7,1,58,0)=" N RA1,RA2,RA3,RA5 S RA1="""",RA3=""A"""
|
---|
| 921 | ^MAGD(2006.79,7,1,59,0)=" F S RA1=$O(RA4(RA1)) Q:RA1="""" K RA4(RA1) ;clean up array"
|
---|
| 922 | ^MAGD(2006.79,7,1,60,0)=" S RA5=$S($G(RARPT):RARPT,$G(RAIEN):RAIEN,1:0) Q:RA5=0"
|
---|
| 923 | ^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"
|
---|
| 924 | ^MAGD(2006.79,7,1,62,0)=" Q"
|
---|
| 925 | ^MAGD(2006.79,7,1,63,0)="XPRI ;loop thru sub-file #74.05 to set/kill prim. xref for other prt members"
|
---|
| 926 | ^MAGD(2006.79,7,1,64,0)=" Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RARAD))!('$D(RAXREF))!('$D(DA))"
|
---|
| 927 | ^MAGD(2006.79,7,1,65,0)=" Q:$O(^RARPT(DA,1,""B"",0))="""""
|
---|
| 928 | ^MAGD(2006.79,7,1,66,0)=" N RA1,RA200 S RA1="""""
|
---|
| 929 | ^MAGD(2006.79,7,1,67,0)="XPRI1 S RA1=$O(^RARPT(DA,1,""B"",RA1)) Q:RA1="""""
|
---|
| 930 | ^MAGD(2006.79,7,1,68,0)=" S RACNIZ=$O(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",""B"",$P(RA1,""-"",2),0))"
|
---|
| 931 | ^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"
|
---|
| 932 | ^MAGD(2006.79,7,1,70,0)=" G XPRI1:'RA200"
|
---|
| 933 | ^MAGD(2006.79,7,1,71,0)=" S:$D(RASET) ^RARPT(RAXREF,RA200,DA)="""""
|
---|
| 934 | ^MAGD(2006.79,7,1,72,0)=" K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)"
|
---|
| 935 | ^MAGD(2006.79,7,1,73,0)=" G XPRI1"
|
---|
| 936 | ^MAGD(2006.79,7,1,74,0)="XSEC ;loop thru sub-file #74.05 to set/kill sec. xref for other print members"
|
---|
| 937 | ^MAGD(2006.79,7,1,75,0)=" Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RASECOND))!('$D(RAXREF))!('$D(DA))"
|
---|
| 938 | ^MAGD(2006.79,7,1,76,0)=" Q:$O(^RARPT(DA,1,""B"",0))="""""
|
---|
| 939 | ^MAGD(2006.79,7,1,77,0)=" N RA1,RA2,RA200 S RA1="""""
|
---|
| 940 | ^MAGD(2006.79,7,1,78,0)="XSEC1 S RA1=$O(^RARPT(DA,1,""B"",RA1)) Q:RA1="""""
|
---|
| 941 | ^MAGD(2006.79,7,1,79,0)=" S RACNIZ=$O(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",""B"",$P(RA1,""-"",2),0))"
|
---|
| 942 | ^MAGD(2006.79,7,1,80,0)=" G:'$D(^RADPT(RADFNZ,""DT"",RADTIZ,""P"",RACNIZ,0)) XSEC1 G:'$D(^(RASECOND,0)) XSEC1"
|
---|
| 943 | ^MAGD(2006.79,7,1,81,0)=" S RA2=0"
|
---|
| 944 | ^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))"
|
---|
| 945 | ^MAGD(2006.79,7,1,83,0)=" G:'RA200 XSEC2"
|
---|
| 946 | ^MAGD(2006.79,7,1,84,0)=" S:$D(RASET) ^RARPT(RAXREF,RA200,DA)="""""
|
---|
| 947 | ^MAGD(2006.79,7,1,85,0)=" K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)"
|
---|
| 948 | ^MAGD(2006.79,7,1,86,0)=" G XSEC2"
|
---|
| 949 | ^MAGD(2006.79,7,1,87,0)="FLAGMEM() ;in distr list, print + if case is part of a print set"
|
---|
| 950 | ^MAGD(2006.79,7,1,88,0)=" ; called from File #74's print templates"
|
---|
| 951 | ^MAGD(2006.79,7,1,89,0)=" N RA1 S RA1="""""
|
---|
| 952 | ^MAGD(2006.79,7,1,90,0)=" I '$D(D0) Q RA1"
|
---|
| 953 | ^MAGD(2006.79,7,1,91,0)=" S RA1=$P($G(^RABTCH(74.4,D0,0)),U) I RA1="""" Q RA1"
|
---|
| 954 | ^MAGD(2006.79,7,1,92,0)=" S RA1=$O(^RARPT(RA1,1,""B"",0)) S:RA1]"""" RA1=""+"""
|
---|
| 955 | ^MAGD(2006.79,7,1,93,0)=" Q RA1"
|
---|
| 956 | ^MAGD(2006.79,7,1,94,0)="DELPNT(RADFN,RADTI,RACNI) ; When an exam is cancelled & it is associated"
|
---|
| 957 | ^MAGD(2006.79,7,1,95,0)=" ; with data in the Nuc Med Exam Data file (70.2) ask the user if this"
|
---|
| 958 | ^MAGD(2006.79,7,1,96,0)=" ; pointer to 70.2 is to be deleted. Also delete the flag which"
|
---|
| 959 | ^MAGD(2006.79,7,1,97,0)=" ; indicates that the dosage ticket had printed for this exam."
|
---|
| 960 | ^MAGD(2006.79,7,1,98,0)=" ; Called from CANCEL^RAEDCN"
|
---|
| 961 | ^MAGD(2006.79,7,1,99,0)=" ; Input: RADFN - Internal Entry Number (IEN) of the Patient."
|
---|
| 962 | ^MAGD(2006.79,7,1,100,0)=" ; RADTI - Date/Time of the examination (inverse format)"
|
---|
| 963 | ^MAGD(2006.79,7,1,101,0)=" ; RACNI - IEN of the exam for this date/time"
|
---|
| 964 | ^MAGD(2006.79,7,1,102,0)=" ;"
|
---|
| 965 | ^MAGD(2006.79,7,1,103,0)=" ;- Delete entry in 'Dosage Ticket Printed?' field DD: 70.03, field: 29 -"
|
---|
| 966 | ^MAGD(2006.79,7,1,104,0)=" N RAFDA S RAFDA(70.03,RACNI_"",""_RADTI_"",""_RADFN_"","",29)=""@"""
|
---|
| 967 | ^MAGD(2006.79,7,1,105,0)=" D FILE^DIE("""",""RAFDA"")"
|
---|
| 968 | ^MAGD(2006.79,7,1,106,0)=" ;----------------------------------------------------------------------"
|
---|
| 969 | ^MAGD(2006.79,7,1,107,0)=" Q:'+$P(^RADPT(RADFN,""DT"",RADTI,""P"",RACNI,0),""^"",28) ;no NucMed Xam data"
|
---|
| 970 | ^MAGD(2006.79,7,1,108,0)=" K RAFDA N RAYN"
|
---|
| 971 | ^MAGD(2006.79,7,1,109,0)=" F D Q:RAYN]"""""
|
---|
| 972 | ^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"
|
---|
| 973 | ^MAGD(2006.79,7,1,111,0)=" . I RAYN[""^""!('$T) S RAYN=""^"" Q ;don't delete pntr if '^' or timeout"
|
---|
| 974 | ^MAGD(2006.79,7,1,112,0)=" . S RAYN=$E(RAYN) S:RAYN="""" RAYN=""N"""
|
---|
| 975 | ^MAGD(2006.79,7,1,113,0)=" . S RAYN=$$UP^XLFSTR(RAYN) Q:RAYN=""N"" ;exit, don't del 70.2 pnt"
|
---|
| 976 | ^MAGD(2006.79,7,1,114,0)=" . I RAYN=""Y"" D Q ; delete the pointer to 70.2, then quit"
|
---|
| 977 | ^MAGD(2006.79,7,1,115,0)=" .. N RAFDA S RAFDA(70.03,RACNI_"",""_RADTI_"",""_RADFN_"","",500)=""@"""
|
---|
| 978 | ^MAGD(2006.79,7,1,116,0)=" .. D FILE^DIE("""",""RAFDA"")"
|
---|
| 979 | ^MAGD(2006.79,7,1,117,0)=" .. ; NOTE: This silent FileMan call not only deletes the pointer to"
|
---|
| 980 | ^MAGD(2006.79,7,1,118,0)=" .. ; the entry in the Nuc Med Exam Data file (70.2), but the"
|
---|
| 981 | ^MAGD(2006.79,7,1,119,0)=" .. ; entry in 70.2 itself. This is because a M X-Ref exists on"
|
---|
| 982 | ^MAGD(2006.79,7,1,120,0)=" .. ; the field which points to file 70.2 that also deletes the"
|
---|
| 983 | ^MAGD(2006.79,7,1,121,0)=" .. ; entry in the Nuc Med Exam Data file. Please refer to"
|
---|
| 984 | ^MAGD(2006.79,7,1,122,0)=" .. ; ^DD(70.03,500,.. for more information."
|
---|
| 985 | ^MAGD(2006.79,7,1,123,0)=" .. Q"
|
---|
| 986 | ^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. """
|
---|
| 987 | ^MAGD(2006.79,7,1,125,0)=" . W ""Enter '^' to exit without deleting the radiopharmaceutical data"",!?3,""associated with this exam."",$C(7)"
|
---|
| 988 | ^MAGD(2006.79,7,1,126,0)=" . S RAYN="""""
|
---|
| 989 | ^MAGD(2006.79,7,1,127,0)=" . Q"
|
---|
| 990 | ^MAGD(2006.79,7,1,128,0)=" Q"
|
---|
| 991 | ^MAGD(2006.79,8,0)="RAUTL3^3060410.105553"
|
---|
| 992 | ^MAGD(2006.79,8,1,0)="^2006.791^61^61"
|
---|
| 993 | ^MAGD(2006.79,8,1,1,0)="RAUTL3 ;HISC/CAH,FPT,GJC AISC/SAW-Utility for Callable Entry Points ;4/1/97 10:04"
|
---|
| 994 | ^MAGD(2006.79,8,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998"
|
---|
| 995 | ^MAGD(2006.79,8,1,3,0)="EN1 ;ENTRY POINT FOR AMIE CALL"
|
---|
| 996 | ^MAGD(2006.79,8,1,4,0)=" ;Requires four input variables"
|
---|
| 997 | ^MAGD(2006.79,8,1,5,0)=" ; DFN = Patient internal entry number"
|
---|
| 998 | ^MAGD(2006.79,8,1,6,0)=" ; Date range for report in Fileman internal format"
|
---|
| 999 | ^MAGD(2006.79,8,1,7,0)=" ; RABDT = Beginning Date (time optional)"
|
---|
| 1000 | ^MAGD(2006.79,8,1,8,0)=" ; RAEDT = Ending Date (time optional)"
|
---|
| 1001 | ^MAGD(2006.79,8,1,9,0)=" ; Exam locations (from file 44, Hospital Location) that are to be"
|
---|
| 1002 | ^MAGD(2006.79,8,1,10,0)=" ; included in the report"
|
---|
| 1003 | ^MAGD(2006.79,8,1,11,0)=" ; RAHLOC = A string of internal entry numbers for locations"
|
---|
| 1004 | ^MAGD(2006.79,8,1,12,0)=" ; Each location separated by ^ and RAHLOC must begin"
|
---|
| 1005 | ^MAGD(2006.79,8,1,13,0)=" ; and end with an ^ (e.g., RAHLOC=^3^ or RAHLOC=^56^75^)"
|
---|
| 1006 | ^MAGD(2006.79,8,1,14,0)=" ; These are REQUESTING locations, not imaging locations"
|
---|
| 1007 | ^MAGD(2006.79,8,1,15,0)=" ;"
|
---|
| 1008 | ^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"
|
---|
| 1009 | ^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"
|
---|
| 1010 | ^MAGD(2006.79,8,1,18,0)=" K RACNI,RAEX,RAII,RAK,RAMDIV,RAMDV,RAMLC,RAMIE,RANUM,RAPT1,RAPTR,RAPTR1,RAPTR2,RASSN,RAST Q"
|
---|
| 1011 | ^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)"
|
---|
| 1012 | ^MAGD(2006.79,8,1,20,0)=" Q"
|
---|
| 1013 | ^MAGD(2006.79,8,1,21,0)="SIGNON ;Check the # of reports to either pre-verify of verify."
|
---|
| 1014 | ^MAGD(2006.79,8,1,22,0)=" Q:'$D(DUZ)#2 N RA74,X0,X1,Y1 S (X0,X1,Y1)=0"
|
---|
| 1015 | ^MAGD(2006.79,8,1,23,0)=" ; first, tabulate # (Y1) of reports to pre-verify (if any)"
|
---|
| 1016 | ^MAGD(2006.79,8,1,24,0)=" F S X0=$O(^RARPT(""ARES"",DUZ,X0)) Q:X0'>0 D"
|
---|
| 1017 | ^MAGD(2006.79,8,1,25,0)=" . S RA74=$G(^RARPT(X0,0))"
|
---|
| 1018 | ^MAGD(2006.79,8,1,26,0)=" . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501"
|
---|
| 1019 | ^MAGD(2006.79,8,1,27,0)=" . Q:$P(RA74,""^"",5)=""V"" ; skip if already verified"
|
---|
| 1020 | ^MAGD(2006.79,8,1,28,0)=" . S:$P(RA74,""^"",12)']"""" Y1=Y1+1"
|
---|
| 1021 | ^MAGD(2006.79,8,1,29,0)=" . Q"
|
---|
| 1022 | ^MAGD(2006.79,8,1,30,0)=" S:Y1 X0=""!*** You have ""_Y1_"" imaging report""_$S(Y1>1:""s"",1:"""")_"" to pre-verify. ***"""
|
---|
| 1023 | ^MAGD(2006.79,8,1,31,0)=" D:Y1 SET^XUS1A(X0)"
|
---|
| 1024 | ^MAGD(2006.79,8,1,32,0)=" ; next tabulate # (X1) of reports to verify (if any)"
|
---|
| 1025 | ^MAGD(2006.79,8,1,33,0)=" S X0=0 F S X0=$O(^RARPT(""ASTF"",DUZ,X0)) Q:X0'>0 D"
|
---|
| 1026 | ^MAGD(2006.79,8,1,34,0)=" . S RA74=$G(^RARPT(X0,0))"
|
---|
| 1027 | ^MAGD(2006.79,8,1,35,0)=" . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501"
|
---|
| 1028 | ^MAGD(2006.79,8,1,36,0)=" . Q:$P(RA74,""^"",5)=""V"" ; skip if already verified"
|
---|
| 1029 | ^MAGD(2006.79,8,1,37,0)=" . S X1=X1+1"
|
---|
| 1030 | ^MAGD(2006.79,8,1,38,0)=" Q:X1'>0"
|
---|
| 1031 | ^MAGD(2006.79,8,1,39,0)=" S X0=""!*** You have ""_X1_"" imaging report""_$S(X1>1:""s"",1:"""")_"" to verify. ***"""
|
---|
| 1032 | ^MAGD(2006.79,8,1,40,0)=" D SET^XUS1A(X0)"
|
---|
| 1033 | ^MAGD(2006.79,8,1,41,0)=" Q"
|
---|
| 1034 | ^MAGD(2006.79,8,1,42,0)="UPDT(RANODE) ; Delete blank lines for Rad/Nuc Med Word Processing fields."
|
---|
| 1035 | ^MAGD(2006.79,8,1,43,0)=" ; These 'blank' consist of nothing more than spaces."
|
---|
| 1036 | ^MAGD(2006.79,8,1,44,0)=" ; 'RANODE' is the data node to be examined: i.e, for Clinical History"
|
---|
| 1037 | ^MAGD(2006.79,8,1,45,0)=" ; in Rad/Nuc Med Orders (75.1) RANODE=""^RAO(75.1,""_DA_"",H,"""
|
---|
| 1038 | ^MAGD(2006.79,8,1,46,0)=" ; -or in Rad/Nuc Med Reports (74) RANODE=""^RARPT(DA_"",R,"""
|
---|
| 1039 | ^MAGD(2006.79,8,1,47,0)=" ; "
|
---|
| 1040 | ^MAGD(2006.79,8,1,48,0)=" N RA0,RACNT,RAI,RATCNT,RAXIT,RAY"
|
---|
| 1041 | ^MAGD(2006.79,8,1,49,0)=" S (RACNT,RATCNT,RAXIT)=0 S RAI=999999999"
|
---|
| 1042 | ^MAGD(2006.79,8,1,50,0)=" S RAY=$G(@(RANODE_""0)"")),RAY(4)=+$P(RAY,""^"",4) Q:'RAY(4)"
|
---|
| 1043 | ^MAGD(2006.79,8,1,51,0)=" F S RAI=$O(@(RANODE_RAI_"")""),-1) Q:RAI'>0 D Q:RAXIT"
|
---|
| 1044 | ^MAGD(2006.79,8,1,52,0)=" . S RA0=$G(@(RANODE_RAI_"",0)""))"
|
---|
| 1045 | ^MAGD(2006.79,8,1,53,0)=" . I RA0?1.999"" "" D"
|
---|
| 1046 | ^MAGD(2006.79,8,1,54,0)=" .. K @(RANODE_RAI_"",0)"") S RACNT=RACNT+1"
|
---|
| 1047 | ^MAGD(2006.79,8,1,55,0)=" . E S RAXIT=1"
|
---|
| 1048 | ^MAGD(2006.79,8,1,56,0)=" . Q"
|
---|
| 1049 | ^MAGD(2006.79,8,1,57,0)=" I RACNT D"
|
---|
| 1050 | ^MAGD(2006.79,8,1,58,0)=" . S RATCNT=RAY(4)-RACNT"
|
---|
| 1051 | ^MAGD(2006.79,8,1,59,0)=" . S @(RANODE_""0)"")=""^^""_RATCNT_""^""_RATCNT_""^""_$S($D(DT)#2:DT,1:$$DT^XLFDT())"
|
---|
| 1052 | ^MAGD(2006.79,8,1,60,0)=" . Q"
|
---|
| 1053 | ^MAGD(2006.79,8,1,61,0)=" Q"
|
---|
| 1054 | ^MAGD(2006.79,9,0)="RAUTL5^3060410.105553"
|
---|
| 1055 | ^MAGD(2006.79,9,1,0)="^2006.791^135^135"
|
---|
| 1056 | ^MAGD(2006.79,9,1,1,0)="RAUTL5 ;HISC/CAH,FPT,GJC-Utility Routine ;3/12/98 13:27"
|
---|
| 1057 | ^MAGD(2006.79,9,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;**8,26**;Mar 16, 1998"
|
---|
| 1058 | ^MAGD(2006.79,9,1,3,0)="CH ; Populate the 'CLINICAL HISTORY' field (400) in file 74 (^RADPT)"
|
---|
| 1059 | ^MAGD(2006.79,9,1,4,0)=" ; Called from 'CREATE1^RAORD1'."
|
---|
| 1060 | ^MAGD(2006.79,9,1,5,0)=" N WPFLG"
|
---|
| 1061 | ^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)"
|
---|
| 1062 | ^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"
|
---|
| 1063 | ^MAGD(2006.79,9,1,8,0)=" S DIC=""^TMP(""_$J_"",""""RAWP"""","",DWPK=1,DIWESUB=""Clin Hist/Reason"" W !,""CLINICAL HISTORY FOR EXAM"""
|
---|
| 1064 | ^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"
|
---|
| 1065 | ^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"
|
---|
| 1066 | ^MAGD(2006.79,9,1,11,0)=" K DIC S DIC=""^TMP(""_$J_"",""""RAWP"""","",DWPK=1"
|
---|
| 1067 | ^MAGD(2006.79,9,1,12,0)=" S WPFLG=$$VALWP(""^TMP(""_$J_"",""""RAWP"""","")"
|
---|
| 1068 | ^MAGD(2006.79,9,1,13,0)=" I 'WPFLG D Q:$D(RAOUT) G CH"
|
---|
| 1069 | ^MAGD(2006.79,9,1,14,0)=" . W !!,$C(7),""A clinical history corresponding to this request is required."",!"
|
---|
| 1070 | ^MAGD(2006.79,9,1,15,0)=" . K DIR S DIR(0)=""Y"",DIR(""B"")=""Yes"""
|
---|
| 1071 | ^MAGD(2006.79,9,1,16,0)=" . S DIR(""A"")=""Do you want to exit processing this request"""
|
---|
| 1072 | ^MAGD(2006.79,9,1,17,0)=" . S DIR(""?"")=""Enter 'Y' for yes, 'N' for no."" D ^DIR K DIR"
|
---|
| 1073 | ^MAGD(2006.79,9,1,18,0)=" . S:+Y!($D(DIRUT)) RAOUT=1 K DIROUT,DIRUT,DTOUT,DUOUT"
|
---|
| 1074 | ^MAGD(2006.79,9,1,19,0)=" . Q"
|
---|
| 1075 | ^MAGD(2006.79,9,1,20,0)="WPLEN ;Is clin hist too long to go into a local array for OE/RR HL7 msg?"
|
---|
| 1076 | ^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"
|
---|
| 1077 | ^MAGD(2006.79,9,1,22,0)=" I CNT>350 K CNT D Q:$D(RAOUT) G CH"
|
---|
| 1078 | ^MAGD(2006.79,9,1,23,0)=" . W !!,$C(7),""Clinical history cannot exceed 350 lines."""
|
---|
| 1079 | ^MAGD(2006.79,9,1,24,0)=" . K DIR S DIR(0)=""Y"",DIR(""B"")=""Yes"""
|
---|
| 1080 | ^MAGD(2006.79,9,1,25,0)=" . S DIR(""A"")=""Do you want to exit processing this request"""
|
---|
| 1081 | ^MAGD(2006.79,9,1,26,0)=" . S DIR(""?"")=""Enter 'Y' for yes, 'N' for no."" D ^DIR K DIR"
|
---|
| 1082 | ^MAGD(2006.79,9,1,27,0)=" . S:+Y!($D(DIRUT)) RAOUT=1 K DIROUT,DIRUT,DTOUT,DUOUT"
|
---|
| 1083 | ^MAGD(2006.79,9,1,28,0)=" . Q"
|
---|
| 1084 | ^MAGD(2006.79,9,1,29,0)=" K CNT Q"
|
---|
| 1085 | ^MAGD(2006.79,9,1,30,0)=" ;"
|
---|
| 1086 | ^MAGD(2006.79,9,1,31,0)="VALWP(RAROOT) ; Validate word processing field."
|
---|
| 1087 | ^MAGD(2006.79,9,1,32,0)=" ; Pass back '1' if data is valid, '0' if not valid."
|
---|
| 1088 | ^MAGD(2006.79,9,1,33,0)=" ; at least 2 alphanumeric char's required"
|
---|
| 1089 | ^MAGD(2006.79,9,1,34,0)=" Q:'$O(@(RAROOT_""0)"")) 0"
|
---|
| 1090 | ^MAGD(2006.79,9,1,35,0)=" N CHAR,CNT,WL,WPFLG,X,Y,Z"
|
---|
| 1091 | ^MAGD(2006.79,9,1,36,0)=" S (WPFLG,X)=0"
|
---|
| 1092 | ^MAGD(2006.79,9,1,37,0)=" F S X=$O(@(RAROOT_X_"")"")) Q:X'>0 D Q:WPFLG"
|
---|
| 1093 | ^MAGD(2006.79,9,1,38,0)=" . S (CNT,WL)=0"
|
---|
| 1094 | ^MAGD(2006.79,9,1,39,0)=" . S Y=$G(@(RAROOT_X_"",0)"")) Q:Y']"""""
|
---|
| 1095 | ^MAGD(2006.79,9,1,40,0)=" . S WL=$L(Y)"
|
---|
| 1096 | ^MAGD(2006.79,9,1,41,0)=" . F Z=1:1:WL D Q:WPFLG"
|
---|
| 1097 | ^MAGD(2006.79,9,1,42,0)=" .. S CHAR=$E(Y,Z) S:CHAR?1AN CNT=CNT+1"
|
---|
| 1098 | ^MAGD(2006.79,9,1,43,0)=" .. S:CHAR'?1AN&(CNT>0) CNT=0 S:CNT=2 WPFLG=1"
|
---|
| 1099 | ^MAGD(2006.79,9,1,44,0)=" .. Q"
|
---|
| 1100 | ^MAGD(2006.79,9,1,45,0)=" . Q"
|
---|
| 1101 | ^MAGD(2006.79,9,1,46,0)=" Q WPFLG"
|
---|
| 1102 | ^MAGD(2006.79,9,1,47,0)="RDQ(D0) ; Used by input transform on ^DD(74.31,2"
|
---|
| 1103 | ^MAGD(2006.79,9,1,48,0)=" ; Checks for unprinted reports associated with REPORT"
|
---|
| 1104 | ^MAGD(2006.79,9,1,49,0)=" ; DISTRIBUTION QUEUE of internal entry number of D0."
|
---|
| 1105 | ^MAGD(2006.79,9,1,50,0)=" N %,%Y,FOUND,RA744"
|
---|
| 1106 | ^MAGD(2006.79,9,1,51,0)=" S (FOUND,RA744)=0"
|
---|
| 1107 | ^MAGD(2006.79,9,1,52,0)=" F S RA744=$O(^RABTCH(74.4,""C"",D0,RA744)) Q:RA744'>0!FOUND D"
|
---|
| 1108 | ^MAGD(2006.79,9,1,53,0)=" . S FOUND=($P($G(^RABTCH(74.4,RA744,0)),""^"",4)'>0)"
|
---|
| 1109 | ^MAGD(2006.79,9,1,54,0)=" . Q"
|
---|
| 1110 | ^MAGD(2006.79,9,1,55,0)=" Q:'FOUND"
|
---|
| 1111 | ^MAGD(2006.79,9,1,56,0)=" W !!,""*** UNPRINTED REPORTS IN THE QUEUE ! ***"""
|
---|
| 1112 | ^MAGD(2006.79,9,1,57,0)=" W !,""If this queue is inactivated before printing, these reports will be"",!,""removed from the queue."""
|
---|
| 1113 | ^MAGD(2006.79,9,1,58,0)=" F D Q:%"
|
---|
| 1114 | ^MAGD(2006.79,9,1,59,0)=" . W !!,""Are you sure you want to remove these reports"""
|
---|
| 1115 | ^MAGD(2006.79,9,1,60,0)=" . S %=2 D YN^DICN"
|
---|
| 1116 | ^MAGD(2006.79,9,1,61,0)=" . I '% W !!?5,""Please answer Y(es) or N(o)."""
|
---|
| 1117 | ^MAGD(2006.79,9,1,62,0)=" . Q"
|
---|
| 1118 | ^MAGD(2006.79,9,1,63,0)=" I %'=1 W !,""Inactivation date deleted"" K X"
|
---|
| 1119 | ^MAGD(2006.79,9,1,64,0)=" Q"
|
---|
| 1120 | ^MAGD(2006.79,9,1,65,0)="ATND(RADFN,DATE) ;Returns the external form of the ATTENDING PHYSICIAN"
|
---|
| 1121 | ^MAGD(2006.79,9,1,66,0)=" ;for patient RADFN (IEN file #2) on date DATE (FM format)"
|
---|
| 1122 | ^MAGD(2006.79,9,1,67,0)=" N DPT,VA200,VAIP,X"
|
---|
| 1123 | ^MAGD(2006.79,9,1,68,0)=" S DFN=RADFN,VAIP(""D"")=DATE,VA200=1"
|
---|
| 1124 | ^MAGD(2006.79,9,1,69,0)=" I DATE D IN5^VADPT"
|
---|
| 1125 | ^MAGD(2006.79,9,1,70,0)=" S X=$P($G(VAIP(18)),""^"",2),X=$S(X]"""":X,1:""UNKNOWN"")"
|
---|
| 1126 | ^MAGD(2006.79,9,1,71,0)=" Q X"
|
---|
| 1127 | ^MAGD(2006.79,9,1,72,0)="PRIM(RADFN,DATE) ;Returns the external form of the PRIMARY PHYSICIAN"
|
---|
| 1128 | ^MAGD(2006.79,9,1,73,0)=" ;for patient RADFN (IEN file #2) on date DATE (FM format)"
|
---|
| 1129 | ^MAGD(2006.79,9,1,74,0)=" N DPT,VA200,VAIP,X"
|
---|
| 1130 | ^MAGD(2006.79,9,1,75,0)=" S DFN=RADFN,VAIP(""D"")=DATE,VA200=1"
|
---|
| 1131 | ^MAGD(2006.79,9,1,76,0)=" I DATE D IN5^VADPT"
|
---|
| 1132 | ^MAGD(2006.79,9,1,77,0)=" I '+$G(VAIP(7)) D"
|
---|
| 1133 | ^MAGD(2006.79,9,1,78,0)=" . ; If the Primary Physician is not found (based on inpatient episode)"
|
---|
| 1134 | ^MAGD(2006.79,9,1,79,0)=" . ; find the current PC Practitioner (See patch SD*5.3*30)"
|
---|
| 1135 | ^MAGD(2006.79,9,1,80,0)=" . ; VAIP(7) is null at this point. VAIP(7) will exit this DO block"
|
---|
| 1136 | ^MAGD(2006.79,9,1,81,0)=" . ; set to the Primary Care Practitioner or null."
|
---|
| 1137 | ^MAGD(2006.79,9,1,82,0)=" . N X S X=""SDUTL3"" X ^%ZOSF(""TEST"")"
|
---|
| 1138 | ^MAGD(2006.79,9,1,83,0)=" . S:$T VAIP(7)=$$OUTPTPR^SDUTL3(RADFN)"
|
---|
| 1139 | ^MAGD(2006.79,9,1,84,0)=" . Q"
|
---|
| 1140 | ^MAGD(2006.79,9,1,85,0)=" S X=$P($G(VAIP(7)),""^"",2),X=$S(X]"""":X,1:""UNKNOWN"")"
|
---|
| 1141 | ^MAGD(2006.79,9,1,86,0)=" Q X"
|
---|
| 1142 | ^MAGD(2006.79,9,1,87,0)="EOS() ; 'End Of Screen' prompt for terminals only, check user response."
|
---|
| 1143 | ^MAGD(2006.79,9,1,88,0)=" Q:$E(IOST,1,2)'=""C-"" 0"
|
---|
| 1144 | ^MAGD(2006.79,9,1,89,0)=" N RAY,X,X1,X2,X3,Y,Y0,Y1,Y2,Y3,Y4,Y5"
|
---|
| 1145 | ^MAGD(2006.79,9,1,90,0)=" ;Returns 1 if user enters anything other than a carriage return"
|
---|
| 1146 | ^MAGD(2006.79,9,1,91,0)=" K DIR S DIR(0)=""E"" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT"
|
---|
| 1147 | ^MAGD(2006.79,9,1,92,0)=" S RAY='+Y"
|
---|
| 1148 | ^MAGD(2006.79,9,1,93,0)=" Q RAY"
|
---|
| 1149 | ^MAGD(2006.79,9,1,94,0)="XTERNAL(Y,C) ; Change internal format to external format"
|
---|
| 1150 | ^MAGD(2006.79,9,1,95,0)=" ; 'Y' is the internal form of the data"
|
---|
| 1151 | ^MAGD(2006.79,9,1,96,0)=" ; 'C' defines the data type of the variable 'Y'"
|
---|
| 1152 | ^MAGD(2006.79,9,1,97,0)=" D:Y]"""" Y^DIQ"
|
---|
| 1153 | ^MAGD(2006.79,9,1,98,0)=" Q Y"
|
---|
| 1154 | ^MAGD(2006.79,9,1,99,0)="PROCMSG(RAPRI) ; Print the appropriate procedure messages. Called from"
|
---|
| 1155 | ^MAGD(2006.79,9,1,100,0)=" ; DESDT^RAUTL12. This code works under the assumption that the"
|
---|
| 1156 | ^MAGD(2006.79,9,1,101,0)=" ; user has entered through OE/RR."
|
---|
| 1157 | ^MAGD(2006.79,9,1,102,0)=" ;ATTENTION: this code must be parallet to code in EN2^RAPRI"
|
---|
| 1158 | ^MAGD(2006.79,9,1,103,0)=" Q:+$G(RASTOP) ; Do not display if displayed in the past."
|
---|
| 1159 | ^MAGD(2006.79,9,1,104,0)=" I $O(^RAMIS(71,RAPRI,3,0)) D S RASTOP=1"
|
---|
| 1160 | ^MAGD(2006.79,9,1,105,0)=" . N I,RAX,X S I=0"
|
---|
| 1161 | ^MAGD(2006.79,9,1,106,0)=" . W !!?5,""NOTE: The following special requirements apply to this """
|
---|
| 1162 | ^MAGD(2006.79,9,1,107,0)=" . W ""procedure:"",$C(7),!"
|
---|
| 1163 | ^MAGD(2006.79,9,1,108,0)=" . F S I=+$O(^RAMIS(71,RAPRI,3,I)) Q:'I D"
|
---|
| 1164 | ^MAGD(2006.79,9,1,109,0)=" .. S RAX=+$G(^RAMIS(71,RAPRI,3,I,0))"
|
---|
| 1165 | ^MAGD(2006.79,9,1,110,0)=" .. I $D(^RAMIS(71.4,+RAX,0)) D"
|
---|
| 1166 | ^MAGD(2006.79,9,1,111,0)=" ... I $Y>(IOSL-6) D READ^ORUTL W @IOF"
|
---|
| 1167 | ^MAGD(2006.79,9,1,112,0)=" ... S X=$G(^RAMIS(71.4,+RAX,0)) W !?3,X"
|
---|
| 1168 | ^MAGD(2006.79,9,1,113,0)=" ... Q"
|
---|
| 1169 | ^MAGD(2006.79,9,1,114,0)=" .. Q"
|
---|
| 1170 | ^MAGD(2006.79,9,1,115,0)=" . Q"
|
---|
| 1171 | ^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"
|
---|
| 1172 | ^MAGD(2006.79,9,1,117,0)=" . W:+$O(^RAMIS(71,+RAPRI,3,0))>0 !!"
|
---|
| 1173 | ^MAGD(2006.79,9,1,118,0)=" . N DIW,DIWF,DIWL,DIWR,RAX,X"
|
---|
| 1174 | ^MAGD(2006.79,9,1,119,0)=" . K ^UTILITY($J,""W"") S DIWF=""W"",DIWL=1,DIWR=75,RAX=0"
|
---|
| 1175 | ^MAGD(2006.79,9,1,120,0)=" . F S RAX=$O(^RAMIS(71,RAPRI,""EDU"",RAX)) Q:RAX'>0 D"
|
---|
| 1176 | ^MAGD(2006.79,9,1,121,0)=" .. I $Y>(IOSL-4) D READ^ORUTL W @IOF"
|
---|
| 1177 | ^MAGD(2006.79,9,1,122,0)=" .. S X=$G(^RAMIS(71,RAPRI,""EDU"",RAX,0)) D ^DIWP"
|
---|
| 1178 | ^MAGD(2006.79,9,1,123,0)=" .. Q"
|
---|
| 1179 | ^MAGD(2006.79,9,1,124,0)=" . I $Y>(IOSL-4) D READ^ORUTL W @IOF"
|
---|
| 1180 | ^MAGD(2006.79,9,1,125,0)=" . D ^DIWW"
|
---|
| 1181 | ^MAGD(2006.79,9,1,126,0)=" . W !"
|
---|
| 1182 | ^MAGD(2006.79,9,1,127,0)=" . Q"
|
---|
| 1183 | ^MAGD(2006.79,9,1,128,0)=" Q"
|
---|
| 1184 | ^MAGD(2006.79,9,1,129,0)="MIDNGHT(X) ; Check if the date passed in is midnight. If it is, add one"
|
---|
| 1185 | ^MAGD(2006.79,9,1,130,0)=" ; minute to the date/time. Fixes infinite loop problem in FM when"
|
---|
| 1186 | ^MAGD(2006.79,9,1,131,0)=" ; midnight."
|
---|
| 1187 | ^MAGD(2006.79,9,1,132,0)=" ; Input: X-Current system date/time (derived from $$NOW^XLFDT)"
|
---|
| 1188 | ^MAGD(2006.79,9,1,133,0)=" S:X[""."" X=$E(X,1,($F(X,""."")+3)) ; chop off seconds IF there's decimal"
|
---|
| 1189 | ^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"
|
---|
| 1190 | ^MAGD(2006.79,9,1,135,0)=" Q X"
|
---|
| 1191 | ^MAGD(2006.79,10,0)="RAXREF^3060410.105553"
|
---|
| 1192 | ^MAGD(2006.79,10,1,0)="^2006.791^27^27"
|
---|
| 1193 | ^MAGD(2006.79,10,1,1,0)="RAXREF ;HISC/DAD-EXECUTE SET AND KILL XREF'S ;8/22/96 15:02"
|
---|
| 1194 | ^MAGD(2006.79,10,1,2,0)=" ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998"
|
---|
| 1195 | ^MAGD(2006.79,10,1,3,0)=" ; REQUIRED VARIABLES"
|
---|
| 1196 | ^MAGD(2006.79,10,1,4,0)=" ; RADICT = DATA DICTIONARY NUMBER"
|
---|
| 1197 | ^MAGD(2006.79,10,1,5,0)=" ; RAFLD = FIELD NUMBER IN THE ABOVE DD"
|
---|
| 1198 | ^MAGD(2006.79,10,1,6,0)=" ; RAX = FIELD VALUE TO BE CROSS REFERENCED"
|
---|
| 1199 | ^MAGD(2006.79,10,1,7,0)=" ; DA = DA or DA array"
|
---|
| 1200 | ^MAGD(2006.79,10,1,8,0)="ENKILL(RADICT,RAFLD,RAX,DA) ;"
|
---|
| 1201 | ^MAGD(2006.79,10,1,9,0)=" ; *** Execute a field's cross reference kill logic"
|
---|
| 1202 | ^MAGD(2006.79,10,1,10,0)=" D CHECK I RAEXIT D EXIT Q"
|
---|
| 1203 | ^MAGD(2006.79,10,1,11,0)=" S RAXSAV=RAX"
|
---|
| 1204 | ^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)"
|
---|
| 1205 | ^MAGD(2006.79,10,1,13,0)=" D EXIT"
|
---|
| 1206 | ^MAGD(2006.79,10,1,14,0)=" Q"
|
---|
| 1207 | ^MAGD(2006.79,10,1,15,0)="ENSET(RADICT,RAFLD,RAX,DA) ;"
|
---|
| 1208 | ^MAGD(2006.79,10,1,16,0)=" ; *** Execute a field's cross reference set logic"
|
---|
| 1209 | ^MAGD(2006.79,10,1,17,0)=" D CHECK I RAEXIT D EXIT Q"
|
---|
| 1210 | ^MAGD(2006.79,10,1,18,0)=" S RAXSAV=RAX"
|
---|
| 1211 | ^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)"
|
---|
| 1212 | ^MAGD(2006.79,10,1,20,0)=" D EXIT"
|
---|
| 1213 | ^MAGD(2006.79,10,1,21,0)=" Q"
|
---|
| 1214 | ^MAGD(2006.79,10,1,22,0)="EXIT ; Kill and quit"
|
---|
| 1215 | ^MAGD(2006.79,10,1,23,0)=" K RAEXIT,RAXREF,RAXSAV"
|
---|
| 1216 | ^MAGD(2006.79,10,1,24,0)=" Q"
|
---|
| 1217 | ^MAGD(2006.79,10,1,25,0)="CHECK ; Check if parameters are valid"
|
---|
| 1218 | ^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)"
|
---|
| 1219 | ^MAGD(2006.79,10,1,27,0)=" Q"
|
---|
| 1220 | ^MAGD(2006.79,11,0)="TIULC1^3060410.105553"
|
---|
| 1221 | ^MAGD(2006.79,11,1,0)="^2006.791^217^217"
|
---|
| 1222 | ^MAGD(2006.79,11,1,1,0)="TIULC1 ; SLC/JER - More computational functions ;11/01/03"
|
---|
| 1223 | ^MAGD(2006.79,11,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**3,4,40,49,100,131,113,112**;Jun 20, 1997"
|
---|
| 1224 | ^MAGD(2006.79,11,1,3,0)=" ; External References"
|
---|
| 1225 | ^MAGD(2006.79,11,1,4,0)=" ; DBIA 2324 $$ISA^USRLM"
|
---|
| 1226 | ^MAGD(2006.79,11,1,5,0)=" ; Any patch which makes ANY changes to this rtn must include a"
|
---|
| 1227 | ^MAGD(2006.79,11,1,6,0)=" ;note in the patch desc reminding sites to update the Imaging"
|
---|
| 1228 | ^MAGD(2006.79,11,1,7,0)=" ;Gateway. See IA # 3622."
|
---|
| 1229 | ^MAGD(2006.79,11,1,8,0)=" ; IN ADDITION, if changes are made to components used by Imaging, "
|
---|
| 1230 | ^MAGD(2006.79,11,1,9,0)=" ;namely PNAME, backward compatibility may not be enough. If"
|
---|
| 1231 | ^MAGD(2006.79,11,1,10,0)=" ;changes call additional rtns, TIU should consult with Imaging"
|
---|
| 1232 | ^MAGD(2006.79,11,1,11,0)=" ;on need to add additional rtns to list of TIU rtns copied for"
|
---|
| 1233 | ^MAGD(2006.79,11,1,12,0)=" ;Imaging Gateway."
|
---|
| 1234 | ^MAGD(2006.79,11,1,13,0)=" ; ****"
|
---|
| 1235 | ^MAGD(2006.79,11,1,14,0)=" ;"
|
---|
| 1236 | ^MAGD(2006.79,11,1,15,0)="ENCRYPT(X,X1,X2) ; Encrypt Text Strings"
|
---|
| 1237 | ^MAGD(2006.79,11,1,16,0)=" D EN^XUSHSHP"
|
---|
| 1238 | ^MAGD(2006.79,11,1,17,0)=" Q X"
|
---|
| 1239 | ^MAGD(2006.79,11,1,18,0)="DECRYPT(X,X1,X2) ; Decrypt Text Strings"
|
---|
| 1240 | ^MAGD(2006.79,11,1,19,0)=" D DE^XUSHSHP"
|
---|
| 1241 | ^MAGD(2006.79,11,1,20,0)=" Q X"
|
---|
| 1242 | ^MAGD(2006.79,11,1,21,0)="WHOSIGNS(DA) ; Evaluate who should be the expected signer"
|
---|
| 1243 | ^MAGD(2006.79,11,1,22,0)=" N Y,TIU12"
|
---|
| 1244 | ^MAGD(2006.79,11,1,23,0)=" S TIU12=$G(^TIU(8925,+DA,12))"
|
---|
| 1245 | ^MAGD(2006.79,11,1,24,0)=" I $P(TIU12,U,2)'=$P(TIU12,U,9) S Y=$P(TIU12,U,2)"
|
---|
| 1246 | ^MAGD(2006.79,11,1,25,0)=" E S Y=$P(TIU12,U,9)"
|
---|
| 1247 | ^MAGD(2006.79,11,1,26,0)=" Q Y"
|
---|
| 1248 | ^MAGD(2006.79,11,1,27,0)="WHOCOSIG(DA) ; Evaluate who should be the expected cosigner"
|
---|
| 1249 | ^MAGD(2006.79,11,1,28,0)=" N Y,TIU12"
|
---|
| 1250 | ^MAGD(2006.79,11,1,29,0)=" S TIU12=$G(^TIU(8925,+DA,12))"
|
---|
| 1251 | ^MAGD(2006.79,11,1,30,0)=" I $P(TIU12,U,2)=$P(TIU12,U,9) D"
|
---|
| 1252 | ^MAGD(2006.79,11,1,31,0)=" . I $P(TIU12,U,8)]"""" S Y=""@"""
|
---|
| 1253 | ^MAGD(2006.79,11,1,32,0)=" . E S Y="""""
|
---|
| 1254 | ^MAGD(2006.79,11,1,33,0)=" E S Y=$P(TIU12,U,9)"
|
---|
| 1255 | ^MAGD(2006.79,11,1,34,0)=" Q Y"
|
---|
| 1256 | ^MAGD(2006.79,11,1,35,0)=" ;"
|
---|
| 1257 | ^MAGD(2006.79,11,1,36,0)="HASADDEN(DA,IDKIDFLG) ; Evaluate whether a given record has addenda"
|
---|
| 1258 | ^MAGD(2006.79,11,1,37,0)=" ; **100**:"
|
---|
| 1259 | ^MAGD(2006.79,11,1,38,0)=" ; If +IDKIDFLG, check interdisciplinary kids of DA, as well as DA."
|
---|
| 1260 | ^MAGD(2006.79,11,1,39,0)=" N TIUI,TIUY,TIUJ,TIUK"
|
---|
| 1261 | ^MAGD(2006.79,11,1,40,0)=" S (TIUI,TIUJ,TIUY)=0"
|
---|
| 1262 | ^MAGD(2006.79,11,1,41,0)=" F S TIUI=$O(^TIU(8925,""DAD"",+DA,TIUI)) Q:+TIUI'>0 D Q:TIUY"
|
---|
| 1263 | ^MAGD(2006.79,11,1,42,0)=" . I $P($G(^TIU(8925.1,+$G(^TIU(8925,+TIUI,0)),0)),U)[""ADDENDUM"" S TIUY=1"
|
---|
| 1264 | ^MAGD(2006.79,11,1,43,0)=" I TIUY!'$G(IDKIDFLG) G HASX"
|
---|
| 1265 | ^MAGD(2006.79,11,1,44,0)=" ;**100** Check ID kids for addenda:"
|
---|
| 1266 | ^MAGD(2006.79,11,1,45,0)=" F S TIUJ=$O(^TIU(8925,""GDAD"",+DA,TIUJ)) Q:+TIUJ'>0 D Q:TIUY"
|
---|
| 1267 | ^MAGD(2006.79,11,1,46,0)=" . S TIUK=0"
|
---|
| 1268 | ^MAGD(2006.79,11,1,47,0)=" . F S TIUK=$O(^TIU(8925,""DAD"",TIUJ,TIUK)) Q:+TIUK'>0 D Q:TIUY"
|
---|
| 1269 | ^MAGD(2006.79,11,1,48,0)=" . . I $P($G(^TIU(8925.1,+$G(^TIU(8925,+TIUK,0)),0)),U)[""ADDENDUM"" S TIUY=1"
|
---|
| 1270 | ^MAGD(2006.79,11,1,49,0)="HASX Q TIUY"
|
---|
| 1271 | ^MAGD(2006.79,11,1,50,0)=" ;"
|
---|
| 1272 | ^MAGD(2006.79,11,1,51,0)="ISADDNDM(DA) ; Evaluate whether a given record IS an addendum"
|
---|
| 1273 | ^MAGD(2006.79,11,1,52,0)=" N TIUY S TIUY=0"
|
---|
| 1274 | ^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"
|
---|
| 1275 | ^MAGD(2006.79,11,1,54,0)=" Q TIUY"
|
---|
| 1276 | ^MAGD(2006.79,11,1,55,0)="PNAME(DA) ; Receives pointer to 8925.1, returns display name of"
|
---|
| 1277 | ^MAGD(2006.79,11,1,56,0)=" ; document class"
|
---|
| 1278 | ^MAGD(2006.79,11,1,57,0)=" N TIUY,TIUMOM S TIUMOM=0"
|
---|
| 1279 | ^MAGD(2006.79,11,1,58,0)=" I +$G(DA)'>0 Q ""UNKNOWN"""
|
---|
| 1280 | ^MAGD(2006.79,11,1,59,0)=" S TIUMOM=$O(^TIU(8925.1,""AD"",DA,TIUMOM))"
|
---|
| 1281 | ^MAGD(2006.79,11,1,60,0)=" I $P($G(^TIU(8925.1,+DA,0)),U,4)=""CO"" S TIUMOM=0"
|
---|
| 1282 | ^MAGD(2006.79,11,1,61,0)=" I +$P($G(^TIU(8925.1,+DA,0)),U,9)=0 S TIUMOM=0"
|
---|
| 1283 | ^MAGD(2006.79,11,1,62,0)=" I +TIUMOM>0 D"
|
---|
| 1284 | ^MAGD(2006.79,11,1,63,0)=" . S TIUY=$P($G(^TIU(8925.1,+TIUMOM,0)),U,3)"
|
---|
| 1285 | ^MAGD(2006.79,11,1,64,0)=" . I TIUY']"""" S TIUY=$$MIXED^TIULS($P($G(^TIU(8925.1,+TIUMOM,0)),U))"
|
---|
| 1286 | ^MAGD(2006.79,11,1,65,0)=" I +TIUMOM'>0 D"
|
---|
| 1287 | ^MAGD(2006.79,11,1,66,0)=" . S TIUY=$P($G(^TIU(8925.1,+DA,0)),U,3)"
|
---|
| 1288 | ^MAGD(2006.79,11,1,67,0)=" . I TIUY']"""" S TIUY=$$MIXED^TIULS($P($G(^TIU(8925.1,+DA,0)),U))"
|
---|
| 1289 | ^MAGD(2006.79,11,1,68,0)=" Q TIUY"
|
---|
| 1290 | ^MAGD(2006.79,11,1,69,0)="ABBREV(DA) ; Get abbreviaton for a document type or class"
|
---|
| 1291 | ^MAGD(2006.79,11,1,70,0)=" Q $P($G(^TIU(8925.1,+DA,0)),U,2)"
|
---|
| 1292 | ^MAGD(2006.79,11,1,71,0)="PERSNAME(USER) ; Receives pointer to 200, returns name field"
|
---|
| 1293 | ^MAGD(2006.79,11,1,72,0)=" N X S X=$$GET1^DIQ(200,USER,.01)"
|
---|
| 1294 | ^MAGD(2006.79,11,1,73,0)=" Q $S($L(X):X,1:""UNKNOWN"")"
|
---|
| 1295 | ^MAGD(2006.79,11,1,74,0)="BEEP(USER) ; Get beeper #'s "
|
---|
| 1296 | ^MAGD(2006.79,11,1,75,0)=" Q $P($G(^VA(200,+USER,.13)),U,7,8)"
|
---|
| 1297 | ^MAGD(2006.79,11,1,76,0)="DOCPRM(TIUTYP,TIUDPRM,TIUDA) ; Get Document Parameters, support inheritance"
|
---|
| 1298 | ^MAGD(2006.79,11,1,77,0)=" N TIUI,TIUDAD"
|
---|
| 1299 | ^MAGD(2006.79,11,1,78,0)=" S (TIUDPRM(0),TIUDPRM(5))="""""
|
---|
| 1300 | ^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))"
|
---|
| 1301 | ^MAGD(2006.79,11,1,80,0)=" S TIUI=+$O(^TIU(8925.95,""B"",+TIUTYP,0))"
|
---|
| 1302 | ^MAGD(2006.79,11,1,81,0)=" I +TIUI D Q"
|
---|
| 1303 | ^MAGD(2006.79,11,1,82,0)=" . S TIUDPRM(0)=$G(^TIU(8925.95,+TIUI,0))"
|
---|
| 1304 | ^MAGD(2006.79,11,1,83,0)=" . I +$O(^TIU(8925.95,+TIUI,5,0)) D"
|
---|
| 1305 | ^MAGD(2006.79,11,1,84,0)=" . . N TIUJ S TIUJ=0"
|
---|
| 1306 | ^MAGD(2006.79,11,1,85,0)=" . . F S TIUJ=$O(^TIU(8925.95,+TIUI,5,TIUJ)) Q:+TIUJ'>0 D"
|
---|
| 1307 | ^MAGD(2006.79,11,1,86,0)=" . . . S $P(TIUDPRM(5),U,TIUJ)=+$G(^TIU(8925.95,+TIUI,5,+TIUJ,0))"
|
---|
| 1308 | ^MAGD(2006.79,11,1,87,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1309 | ^MAGD(2006.79,11,1,88,0)=" I +TIUDAD D DOCPRM(TIUDAD,.TIUDPRM)"
|
---|
| 1310 | ^MAGD(2006.79,11,1,89,0)=" Q"
|
---|
| 1311 | ^MAGD(2006.79,11,1,90,0)="POSTFILE(TIUTYP) ; Get Post-filing Code, support inheritance"
|
---|
| 1312 | ^MAGD(2006.79,11,1,91,0)=" N TIUPOST,TIUDAD"
|
---|
| 1313 | ^MAGD(2006.79,11,1,92,0)=" S TIUPOST=$G(^TIU(8925.1,+TIUTYP,4.5))"
|
---|
| 1314 | ^MAGD(2006.79,11,1,93,0)=" I TIUPOST]"""" G POSTFILX"
|
---|
| 1315 | ^MAGD(2006.79,11,1,94,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1316 | ^MAGD(2006.79,11,1,95,0)=" I +TIUDAD S TIUPOST=$$POSTFILE(TIUDAD)"
|
---|
| 1317 | ^MAGD(2006.79,11,1,96,0)="POSTFILX Q TIUPOST"
|
---|
| 1318 | ^MAGD(2006.79,11,1,97,0)="FIXCODE(TIUTYP) ; Get Error Resolution Code, support inheritance"
|
---|
| 1319 | ^MAGD(2006.79,11,1,98,0)=" N TIUFIX,TIUDAD"
|
---|
| 1320 | ^MAGD(2006.79,11,1,99,0)=" S TIUFIX=$G(^TIU(8925.1,+TIUTYP,4.8))"
|
---|
| 1321 | ^MAGD(2006.79,11,1,100,0)=" I TIUFIX]"""" G FIXCODX"
|
---|
| 1322 | ^MAGD(2006.79,11,1,101,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1323 | ^MAGD(2006.79,11,1,102,0)=" ; Don't inherit PN code for consults: TIU*1*131"
|
---|
| 1324 | ^MAGD(2006.79,11,1,103,0)=" I +TIUTYP=$$CLASS^TIUCNSLT,TIUDAD=3 G FIXCODX"
|
---|
| 1325 | ^MAGD(2006.79,11,1,104,0)=" I +TIUDAD S TIUFIX=$$FIXCODE(TIUDAD)"
|
---|
| 1326 | ^MAGD(2006.79,11,1,105,0)="FIXCODX Q TIUFIX"
|
---|
| 1327 | ^MAGD(2006.79,11,1,106,0)="DOCCLASS(TIUTYP) ; Given a document type, find its parent document class"
|
---|
| 1328 | ^MAGD(2006.79,11,1,107,0)=" Q +$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1329 | ^MAGD(2006.79,11,1,108,0)="CLINDOC(TIUTYP,TIUDA) ; Given a document type, find the Clinical Document"
|
---|
| 1330 | ^MAGD(2006.79,11,1,109,0)=" ; subclass to which it belongs"
|
---|
| 1331 | ^MAGD(2006.79,11,1,110,0)=" N TIUI,TIUY S (TIUI,TIUY)=0"
|
---|
| 1332 | ^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))"
|
---|
| 1333 | ^MAGD(2006.79,11,1,112,0)=" S TIUI=$O(^TIU(8925.1,""AD"",+TIUTYP,TIUI))"
|
---|
| 1334 | ^MAGD(2006.79,11,1,113,0)=" I +TIUI'>0 G CLINDOX"
|
---|
| 1335 | ^MAGD(2006.79,11,1,114,0)=" I TIUI=38 S TIUY=TIUTYP"
|
---|
| 1336 | ^MAGD(2006.79,11,1,115,0)=" I TIUI'=38 S TIUY=$$CLINDOC(TIUI)"
|
---|
| 1337 | ^MAGD(2006.79,11,1,116,0)="CLINDOX Q TIUY"
|
---|
| 1338 | ^MAGD(2006.79,11,1,117,0)="REQVER(TIUTYP,TIUDA) ; Does a given document type require verification"
|
---|
| 1339 | ^MAGD(2006.79,11,1,118,0)=" N TIUDPRM,TIUY"
|
---|
| 1340 | ^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))"
|
---|
| 1341 | ^MAGD(2006.79,11,1,120,0)=" D DOCPRM(TIUTYP,.TIUDPRM)"
|
---|
| 1342 | ^MAGD(2006.79,11,1,121,0)=" I +$P($G(TIUDPRM(0)),U,3) S TIUY=1"
|
---|
| 1343 | ^MAGD(2006.79,11,1,122,0)=" Q +$G(TIUY)"
|
---|
| 1344 | ^MAGD(2006.79,11,1,123,0)="REFDATE(TIU,TIUDICDT) ; Identify Reference date"
|
---|
| 1345 | ^MAGD(2006.79,11,1,124,0)=" N TIURDT"
|
---|
| 1346 | ^MAGD(2006.79,11,1,125,0)=" I +$G(TIU(""LDT"")) S TIURDT=+$G(TIU(""LDT""))_""^0"""
|
---|
| 1347 | ^MAGD(2006.79,11,1,126,0)=" I +$G(TIU(""LDT""))'>0 D"
|
---|
| 1348 | ^MAGD(2006.79,11,1,127,0)=" . S TIURDT=$S(+$G(TIUDICDT):+$G(TIUDICDT),1:+$$NOW^TIULC)_""^1"""
|
---|
| 1349 | ^MAGD(2006.79,11,1,128,0)=" . S TIU(""LDT"")=TIURDT_U_$$DATE^TIULS(TIURDT,""AMTH DD, CCYY@HR:MIN:SEC"")"
|
---|
| 1350 | ^MAGD(2006.79,11,1,129,0)=" Q TIURDT"
|
---|
| 1351 | ^MAGD(2006.79,11,1,130,0)="WHATMPL(USER) ; What List Template should a given user get?"
|
---|
| 1352 | ^MAGD(2006.79,11,1,131,0)=" N TIUY"
|
---|
| 1353 | ^MAGD(2006.79,11,1,132,0)=" I +$$ISA^USRLM(USER,""PROVIDER"") S TIUY=""TIU BROWSE FOR CLINICIAN"" G WHAX"
|
---|
| 1354 | ^MAGD(2006.79,11,1,133,0)=" I +$$ISA^USRLM(USER,""MEDICAL RECORDS TECHNICIAN"") S TIUY=""TIU BROWSE FOR MRT"" G WHAX"
|
---|
| 1355 | ^MAGD(2006.79,11,1,134,0)=" I +$$ISA^USRLM(USER,""CHIEF, MIS"") S TIUY=""TIU BROWSE FOR MGR"" G WHAX"
|
---|
| 1356 | ^MAGD(2006.79,11,1,135,0)=" I +$$ISA^USRLM(USER,""MEDICAL STUDENT"") S TIUY=""TIU BROWSE FOR CLINICIAN"" G WHAX"
|
---|
| 1357 | ^MAGD(2006.79,11,1,136,0)=" S TIUY=""TIU BROWSE FOR READ ONLY"""
|
---|
| 1358 | ^MAGD(2006.79,11,1,137,0)="WHAX Q TIUY"
|
---|
| 1359 | ^MAGD(2006.79,11,1,138,0)="SUPPVSIT(TIUTYP) ; Evaluate whether to suppress visit matching"
|
---|
| 1360 | ^MAGD(2006.79,11,1,139,0)=" N TIUI,TIUY S TIUY=0"
|
---|
| 1361 | ^MAGD(2006.79,11,1,140,0)=" I +$P($G(^TIU(8925.1,+TIUTYP,3)),U,3) S TIUY=1 G SUPPVSIX"
|
---|
| 1362 | ^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"
|
---|
| 1363 | ^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"
|
---|
| 1364 | ^MAGD(2006.79,11,1,143,0)=" . S TIUY=+$$SUPPVSIT(+TIUI)"
|
---|
| 1365 | ^MAGD(2006.79,11,1,144,0)="SUPPVSIX Q TIUY"
|
---|
| 1366 | ^MAGD(2006.79,11,1,145,0)="PTNAME(DFN) ; Resolve Patient Name"
|
---|
| 1367 | ^MAGD(2006.79,11,1,146,0)=" N TIUY S TIUY=$P($G(^DPT(DFN,0)),U)"
|
---|
| 1368 | ^MAGD(2006.79,11,1,147,0)=" S:TIUY']"""" TIUY=""NAME UNKNOWN"""
|
---|
| 1369 | ^MAGD(2006.79,11,1,148,0)=" Q TIUY"
|
---|
| 1370 | ^MAGD(2006.79,11,1,149,0)="POSTSIGN(TIUTYP) ; Get Post-Signature Code, support inheritance"
|
---|
| 1371 | ^MAGD(2006.79,11,1,150,0)=" N TIUPOST,TIUDAD"
|
---|
| 1372 | ^MAGD(2006.79,11,1,151,0)=" S TIUPOST=$G(^TIU(8925.1,+TIUTYP,4.9))"
|
---|
| 1373 | ^MAGD(2006.79,11,1,152,0)=" I TIUPOST]"""" G POSTSIGX"
|
---|
| 1374 | ^MAGD(2006.79,11,1,153,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1375 | ^MAGD(2006.79,11,1,154,0)=" I +TIUDAD S TIUPOST=$$POSTSIGN(TIUDAD)"
|
---|
| 1376 | ^MAGD(2006.79,11,1,155,0)="POSTSIGX Q TIUPOST"
|
---|
| 1377 | ^MAGD(2006.79,11,1,156,0)="COMMIT(TIUTYP) ; Get Commitment action, support inheritance"
|
---|
| 1378 | ^MAGD(2006.79,11,1,157,0)=" N TIUCOMM,TIUDAD"
|
---|
| 1379 | ^MAGD(2006.79,11,1,158,0)=" S TIUCOMM=$G(^TIU(8925.1,+TIUTYP,4.1))"
|
---|
| 1380 | ^MAGD(2006.79,11,1,159,0)=" I TIUCOMM]"""" G COMMITX"
|
---|
| 1381 | ^MAGD(2006.79,11,1,160,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1382 | ^MAGD(2006.79,11,1,161,0)=" I +TIUDAD S TIUCOMM=$$COMMIT(TIUDAD)"
|
---|
| 1383 | ^MAGD(2006.79,11,1,162,0)="COMMITX Q TIUCOMM"
|
---|
| 1384 | ^MAGD(2006.79,11,1,163,0)="RELEASE(TIUTYP) ; Get Release Action, support inheritance"
|
---|
| 1385 | ^MAGD(2006.79,11,1,164,0)=" N TIUREL,TIUDAD"
|
---|
| 1386 | ^MAGD(2006.79,11,1,165,0)=" S TIUREL=$G(^TIU(8925.1,+TIUTYP,4.2))"
|
---|
| 1387 | ^MAGD(2006.79,11,1,166,0)=" I TIUREL]"""" G RELEASX"
|
---|
| 1388 | ^MAGD(2006.79,11,1,167,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1389 | ^MAGD(2006.79,11,1,168,0)=" I +TIUDAD S TIUREL=$$RELEASE(TIUDAD)"
|
---|
| 1390 | ^MAGD(2006.79,11,1,169,0)="RELEASX Q TIUREL"
|
---|
| 1391 | ^MAGD(2006.79,11,1,170,0)="VERIFY(TIUTYP) ; Get Verification action, support inheritance"
|
---|
| 1392 | ^MAGD(2006.79,11,1,171,0)=" N TIUVER,TIUDAD"
|
---|
| 1393 | ^MAGD(2006.79,11,1,172,0)=" S TIUVER=$G(^TIU(8925.1,+TIUTYP,4.3))"
|
---|
| 1394 | ^MAGD(2006.79,11,1,173,0)=" I TIUVER]"""" G VERIFYX"
|
---|
| 1395 | ^MAGD(2006.79,11,1,174,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1396 | ^MAGD(2006.79,11,1,175,0)=" I +TIUDAD S TIUVER=$$VERIFY(TIUDAD)"
|
---|
| 1397 | ^MAGD(2006.79,11,1,176,0)="VERIFYX Q TIUVER"
|
---|
| 1398 | ^MAGD(2006.79,11,1,177,0)="DELETE(TIUTYP) ; Get Delete Action, support inheritance"
|
---|
| 1399 | ^MAGD(2006.79,11,1,178,0)=" N TIUDEL,TIUDAD"
|
---|
| 1400 | ^MAGD(2006.79,11,1,179,0)=" S TIUDEL=$G(^TIU(8925.1,+TIUTYP,4.4))"
|
---|
| 1401 | ^MAGD(2006.79,11,1,180,0)=" I TIUDEL]"""" G DELETEX"
|
---|
| 1402 | ^MAGD(2006.79,11,1,181,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1403 | ^MAGD(2006.79,11,1,182,0)=" I +TIUDAD S TIUDEL=$$DELETE(TIUDAD)"
|
---|
| 1404 | ^MAGD(2006.79,11,1,183,0)="DELETEX Q TIUDEL"
|
---|
| 1405 | ^MAGD(2006.79,11,1,184,0)="REASSIGN(TIUTYP) ; Get Package Reassign Action, support inheritance"
|
---|
| 1406 | ^MAGD(2006.79,11,1,185,0)=" N TIUREASS,TIUDAD"
|
---|
| 1407 | ^MAGD(2006.79,11,1,186,0)=" S TIUREASS=$G(^TIU(8925.1,+TIUTYP,4.45))"
|
---|
| 1408 | ^MAGD(2006.79,11,1,187,0)=" I TIUREASS]"""" G REASSIX"
|
---|
| 1409 | ^MAGD(2006.79,11,1,188,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1410 | ^MAGD(2006.79,11,1,189,0)=" I +TIUDAD S TIUREASS=$$REASSIGN(TIUDAD)"
|
---|
| 1411 | ^MAGD(2006.79,11,1,190,0)="REASSIX Q TIUREASS"
|
---|
| 1412 | ^MAGD(2006.79,11,1,191,0)="ONBROWSE(TIUTYP) ; Get OnBrowse Event, support inheritance"
|
---|
| 1413 | ^MAGD(2006.79,11,1,192,0)=" N TIUBRWS,TIUDAD"
|
---|
| 1414 | ^MAGD(2006.79,11,1,193,0)=" S TIUBRWS=$G(^TIU(8925.1,+TIUTYP,6.5))"
|
---|
| 1415 | ^MAGD(2006.79,11,1,194,0)=" I TIUBRWS]"""" G ONBRWSX"
|
---|
| 1416 | ^MAGD(2006.79,11,1,195,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1417 | ^MAGD(2006.79,11,1,196,0)=" I +TIUDAD S TIUBRWS=$$ONBROWSE(TIUDAD)"
|
---|
| 1418 | ^MAGD(2006.79,11,1,197,0)="ONBRWSX Q TIUBRWS"
|
---|
| 1419 | ^MAGD(2006.79,11,1,198,0)="ONRTRCT(TIUTYP) ; Get OnRetract Event, support inheritance"
|
---|
| 1420 | ^MAGD(2006.79,11,1,199,0)=" N TIURTRCT,TIUDAD"
|
---|
| 1421 | ^MAGD(2006.79,11,1,200,0)=" S TIURTRCT=$G(^TIU(8925.1,+TIUTYP,6.51))"
|
---|
| 1422 | ^MAGD(2006.79,11,1,201,0)=" I TIURTRCT]"""" G ONRTRX"
|
---|
| 1423 | ^MAGD(2006.79,11,1,202,0)=" S TIUDAD=$O(^TIU(8925.1,""AD"",+TIUTYP,0))"
|
---|
| 1424 | ^MAGD(2006.79,11,1,203,0)=" I +TIUDAD S TIURTRCT=$$ONRTRCT(TIUDAD)"
|
---|
| 1425 | ^MAGD(2006.79,11,1,204,0)="ONRTRX Q TIURTRCT"
|
---|
| 1426 | ^MAGD(2006.79,11,1,205,0)="DIVISION(TIULOC) ; Get Division"
|
---|
| 1427 | ^MAGD(2006.79,11,1,206,0)=" ; Input -- TIULOC HOSPITAL LOCATION file (#44) IEN"
|
---|
| 1428 | ^MAGD(2006.79,11,1,207,0)=" ; Output -- TIUIN INSTITUTION file (#4) IEN^"
|
---|
| 1429 | ^MAGD(2006.79,11,1,208,0)=" ; INSTITUTION file (#4) NAME"
|
---|
| 1430 | ^MAGD(2006.79,11,1,209,0)=" N TIUDVHL,TIUSTN,TIUIN"
|
---|
| 1431 | ^MAGD(2006.79,11,1,210,0)=" S TIUDVHL=$P($G(^SC(+TIULOC,0)),U,15)"
|
---|
| 1432 | ^MAGD(2006.79,11,1,211,0)=" I +TIUDVHL D"
|
---|
| 1433 | ^MAGD(2006.79,11,1,212,0)=" . S TIUSTN=$$SITE^VASITE(,TIUDVHL)"
|
---|
| 1434 | ^MAGD(2006.79,11,1,213,0)=" . I $P(TIUSTN,U)>0,($P(TIUSTN,U,2)]"""") D"
|
---|
| 1435 | ^MAGD(2006.79,11,1,214,0)=" . . S TIUIN=$P(TIUSTN,U)_U_$P(TIUSTN,U,2)"
|
---|
| 1436 | ^MAGD(2006.79,11,1,215,0)=" I '$G(TIUIN) D"
|
---|
| 1437 | ^MAGD(2006.79,11,1,216,0)=" . S TIUIN=+$G(DUZ(2))_U_$P($$NS^XUAF4(+$G(DUZ(2))),U)"
|
---|
| 1438 | ^MAGD(2006.79,11,1,217,0)=" Q TIUIN"
|
---|
| 1439 | ^MAGD(2006.79,12,0)="TIULS^3060410.105553"
|
---|
| 1440 | ^MAGD(2006.79,12,1,0)="^2006.791^104^104"
|
---|
| 1441 | ^MAGD(2006.79,12,1,1,0)="TIULS ; SLC/JER - String Library functions ;10/7/94 17:18 [1/5/04 11:29am]"
|
---|
| 1442 | ^MAGD(2006.79,12,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**178**;Jun 20, 1997"
|
---|
| 1443 | ^MAGD(2006.79,12,1,3,0)=" ;"
|
---|
| 1444 | ^MAGD(2006.79,12,1,4,0)=" ; **** WARNING ****"
|
---|
| 1445 | ^MAGD(2006.79,12,1,5,0)=" ;"
|
---|
| 1446 | ^MAGD(2006.79,12,1,6,0)=" ; Any patch which makes ANY changes to this rtn must include a"
|
---|
| 1447 | ^MAGD(2006.79,12,1,7,0)=" ;note in the patch desc reminding sites to update the Imaging"
|
---|
| 1448 | ^MAGD(2006.79,12,1,8,0)=" ;Gateway. See IA # 3622."
|
---|
| 1449 | ^MAGD(2006.79,12,1,9,0)=" ; IN ADDITION, if changes are made to components used by Imaging,"
|
---|
| 1450 | ^MAGD(2006.79,12,1,10,0)=" ;namely, MIXED, backward compatibility may not be enough. If"
|
---|
| 1451 | ^MAGD(2006.79,12,1,11,0)=" ;changes call additional rtns, TIU should consult with Imaging"
|
---|
| 1452 | ^MAGD(2006.79,12,1,12,0)=" ;on need to add additional rtns to list of TIU rtns copied for"
|
---|
| 1453 | ^MAGD(2006.79,12,1,13,0)=" ;Imaging Gateway."
|
---|
| 1454 | ^MAGD(2006.79,12,1,14,0)=" ; ****"
|
---|
| 1455 | ^MAGD(2006.79,12,1,15,0)=" ;"
|
---|
| 1456 | ^MAGD(2006.79,12,1,16,0)="TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS)."
|
---|
| 1457 | ^MAGD(2006.79,12,1,17,0)=" N HR,MIN,SEC,TIUI"
|
---|
| 1458 | ^MAGD(2006.79,12,1,18,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""HR:MIN"""
|
---|
| 1459 | ^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)))"
|
---|
| 1460 | ^MAGD(2006.79,12,1,20,0)=" F TIUI=""HR"",""MIN"",""SEC"" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)"
|
---|
| 1461 | ^MAGD(2006.79,12,1,21,0)=" Q FMT"
|
---|
| 1462 | ^MAGD(2006.79,12,1,22,0)="DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date (""MM/DD"")"
|
---|
| 1463 | ^MAGD(2006.79,12,1,23,0)=" N AMTH,MM,CC,DD,YY,TIUI,TIUTMP"
|
---|
| 1464 | ^MAGD(2006.79,12,1,24,0)=" I +X'>0 S $P(TIUTMP,"" "",$L($G(FMT))+1)="""",FMT=TIUTMP G QDATE"
|
---|
| 1465 | ^MAGD(2006.79,12,1,25,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""MM/DD/YY"""
|
---|
| 1466 | ^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)"
|
---|
| 1467 | ^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)"
|
---|
| 1468 | ^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)"
|
---|
| 1469 | ^MAGD(2006.79,12,1,29,0)=" I FMT[""HR"" S FMT=$$TIME(X,FMT)"
|
---|
| 1470 | ^MAGD(2006.79,12,1,30,0)="QDATE Q FMT"
|
---|
| 1471 | ^MAGD(2006.79,12,1,31,0)="NAME(X,FMT) ; Call with X=""LAST,FIRST MI"", FMT=Return Format (""LAST, FI"")"
|
---|
| 1472 | ^MAGD(2006.79,12,1,32,0)=" N TIULAST,TIULI,TIUFIRST,TIUFI,TIUMI,TIUI"
|
---|
| 1473 | ^MAGD(2006.79,12,1,33,0)=" I X']"""" S FMT="""" G NAMEX"
|
---|
| 1474 | ^MAGD(2006.79,12,1,34,0)=" I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT=""LAST,FIRST"""
|
---|
| 1475 | ^MAGD(2006.79,12,1,35,0)=" S FMT=$$LOWER(FMT)"
|
---|
| 1476 | ^MAGD(2006.79,12,1,36,0)=" S TIULAST=$P(X,"",""),TIULI=$E(TIULAST),TIUFIRST=$P(X,"","",2)"
|
---|
| 1477 | ^MAGD(2006.79,12,1,37,0)=" S TIUFI=$E(TIUFIRST)"
|
---|
| 1478 | ^MAGD(2006.79,12,1,38,0)=" S TIUMI=$S($P(TIUFIRST,"" "",2)'=""NMI"":$E($P(TIUFIRST,"" "",2)),1:"""")"
|
---|
| 1479 | ^MAGD(2006.79,12,1,39,0)=" S TIUFIRST=$P(TIUFIRST,"" "")"
|
---|
| 1480 | ^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)"
|
---|
| 1481 | ^MAGD(2006.79,12,1,41,0)="NAMEX Q FMT"
|
---|
| 1482 | ^MAGD(2006.79,12,1,42,0)="INAME(X) ; Call with X=""FIRST MI[.] LAST[,M.D.]"", RETURNS ""LAST,FIRST MI"""
|
---|
| 1483 | ^MAGD(2006.79,12,1,43,0)=" N LAST,FIRST,MIDDLE,NAME,MI"
|
---|
| 1484 | ^MAGD(2006.79,12,1,44,0)=" I X'?1.A1"" "".E S NAME=X G INAMEX"
|
---|
| 1485 | ^MAGD(2006.79,12,1,45,0)=" S NAME=$P(X,"",""),FIRST=$P(NAME,"" ""),MIDDLE=$S($L(NAME,"" "")=3:$P(NAME,"" "",2),1:"""")"
|
---|
| 1486 | ^MAGD(2006.79,12,1,46,0)=" S LAST=$P(NAME,"" "",$L(NAME,"" "")),MI=$S($L(MIDDLE):$E(MIDDLE),1:"""")"
|
---|
| 1487 | ^MAGD(2006.79,12,1,47,0)=" S NAME=LAST_"",""_FIRST_$S($L(MI):"" ""_MI,1:"""")"
|
---|
| 1488 | ^MAGD(2006.79,12,1,48,0)="INAMEX Q NAME"
|
---|
| 1489 | ^MAGD(2006.79,12,1,49,0)="WORD(X,FMT) ; Call with X=Word Processing array root, FMT=Wrap Width"
|
---|
| 1490 | ^MAGD(2006.79,12,1,50,0)=" N X,DIWL,DIWF,TIUI K ^UTILITY($J,""W"")"
|
---|
| 1491 | ^MAGD(2006.79,12,1,51,0)=" S DIWL=2,DIWF=""WRC""_FMT"
|
---|
| 1492 | ^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"
|
---|
| 1493 | ^MAGD(2006.79,12,1,53,0)=" D ^DIWW K ^UTILITY($J,""W"")"
|
---|
| 1494 | ^MAGD(2006.79,12,1,54,0)=" Q """""
|
---|
| 1495 | ^MAGD(2006.79,12,1,55,0)="UPPER(X) ; Convert lower case X to UPPER CASE"
|
---|
| 1496 | ^MAGD(2006.79,12,1,56,0)=" Q $TR(X,""abcdefghijklmnopqrstuvwxyz"",""ABCDEFGHIJKLMNOPQRSTUVWXYZ"")"
|
---|
| 1497 | ^MAGD(2006.79,12,1,57,0)="LOWER(X) ; Convert UPPER CASE X to lower case"
|
---|
| 1498 | ^MAGD(2006.79,12,1,58,0)=" Q $TR(X,""ABCDEFGHIJKLMNOPQRSTUVWXYZ"",""abcdefghijklmnopqrstuvwxyz"")"
|
---|
| 1499 | ^MAGD(2006.79,12,1,59,0)="MIXED(X) ; Return Mixed Case X"
|
---|
| 1500 | ^MAGD(2006.79,12,1,60,0)=" N TIUI,WORD,TMP"
|
---|
| 1501 | ^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)"
|
---|
| 1502 | ^MAGD(2006.79,12,1,62,0)=" Q TMP"
|
---|
| 1503 | ^MAGD(2006.79,12,1,63,0)="STRIP(TEXT) ; Strips white space from text"
|
---|
| 1504 | ^MAGD(2006.79,12,1,64,0)=" N TIUTI,TIUX"
|
---|
| 1505 | ^MAGD(2006.79,12,1,65,0)=" ; First remove TABS"
|
---|
| 1506 | ^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))"
|
---|
| 1507 | ^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)"
|
---|
| 1508 | ^MAGD(2006.79,12,1,68,0)=" S TEXT=TIUX S:$P(TEXT,"" "")']"""" TEXT=$P(TEXT,"" "",2,$L(TEXT,"" ""))"
|
---|
| 1509 | ^MAGD(2006.79,12,1,69,0)=" Q TEXT"
|
---|
| 1510 | ^MAGD(2006.79,12,1,70,0)="SIGNAME(TIUDA) ; Get/Return Signature Block Printed Name"
|
---|
| 1511 | ^MAGD(2006.79,12,1,71,0)=" Q $P($G(^VA(200,+TIUDA,20)),U,2)"
|
---|
| 1512 | ^MAGD(2006.79,12,1,72,0)="SIGTITL(TIUDA) ; Get/Return Signature Block Printed Name"
|
---|
| 1513 | ^MAGD(2006.79,12,1,73,0)=" Q $P($G(^VA(200,+TIUDA,20)),U,3)"
|
---|
| 1514 | ^MAGD(2006.79,12,1,74,0)="CENTER(X) ; Center X"
|
---|
| 1515 | ^MAGD(2006.79,12,1,75,0)=" N SP"
|
---|
| 1516 | ^MAGD(2006.79,12,1,76,0)=" S $P(SP,"" "",((IOM-$L(X))\2))="""""
|
---|
| 1517 | ^MAGD(2006.79,12,1,77,0)=" Q $G(SP)_X"
|
---|
| 1518 | ^MAGD(2006.79,12,1,78,0)="URGENCY(X) ; Input transform for urgency codes"
|
---|
| 1519 | ^MAGD(2006.79,12,1,79,0)=" Q $S($$UPPER(X)=""STAT"":""P"",1:$E(X))"
|
---|
| 1520 | ^MAGD(2006.79,12,1,80,0)="FILL(X,Y,LEN) ; Append "", ""_X to Y, unless Y would excede LEN"
|
---|
| 1521 | ^MAGD(2006.79,12,1,81,0)=" Q $S('$L(Y):X,($L(Y_$C(44)_"" ""_X)'>LEN):Y_$C(44)_"" ""_X,1:X)"
|
---|
| 1522 | ^MAGD(2006.79,12,1,82,0)="PARSE(X,Y) ; Parse string X, return array Y with list of words from X"
|
---|
| 1523 | ^MAGD(2006.79,12,1,83,0)=" N I,WORD"
|
---|
| 1524 | ^MAGD(2006.79,12,1,84,0)=" F I=1:1:$L(X,"" "") D"
|
---|
| 1525 | ^MAGD(2006.79,12,1,85,0)=" . S WORD=$P(X,"" "",I),WORD=$TR(WORD,"".,!&?/|\{}[];:=+*^%$#@~`""""><"")"
|
---|
| 1526 | ^MAGD(2006.79,12,1,86,0)=" . S:WORD]"""" Y(I)=$$UPPER(WORD)"
|
---|
| 1527 | ^MAGD(2006.79,12,1,87,0)=" Q"
|
---|
| 1528 | ^MAGD(2006.79,12,1,88,0)="HASNUM(X) ; Boolean - evaluates whether X contains a number"
|
---|
| 1529 | ^MAGD(2006.79,12,1,89,0)=" N I,Y F I=0:1:9 I X[I S Y=1"
|
---|
| 1530 | ^MAGD(2006.79,12,1,90,0)=" Q +$G(Y)"
|
---|
| 1531 | ^MAGD(2006.79,12,1,91,0)="WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH"
|
---|
| 1532 | ^MAGD(2006.79,12,1,92,0)=" N TIUI,TIUJ,LINE,TIUX,TIUX1,TIUX2,TIUY"
|
---|
| 1533 | ^MAGD(2006.79,12,1,93,0)=" I $G(TEXT)']"""" Q """""
|
---|
| 1534 | ^MAGD(2006.79,12,1,94,0)=" F TIUI=1:1 D Q:TIUI=$L(TEXT,"" "")"
|
---|
| 1535 | ^MAGD(2006.79,12,1,95,0)=" . S TIUX=$P(TEXT,"" "",TIUI)"
|
---|
| 1536 | ^MAGD(2006.79,12,1,96,0)=" . I $L(TIUX)>LENGTH D"
|
---|
| 1537 | ^MAGD(2006.79,12,1,97,0)=" . . S TIUX1=$E(TIUX,1,LENGTH),TIUX2=$E(TIUX,LENGTH+1,$L(TIUX))"
|
---|
| 1538 | ^MAGD(2006.79,12,1,98,0)=" . . S $P(TEXT,"" "",TIUI)=TIUX1_"" ""_TIUX2"
|
---|
| 1539 | ^MAGD(2006.79,12,1,99,0)=" S LINE=1,TIUX(1)=$P(TEXT,"" "")"
|
---|
| 1540 | ^MAGD(2006.79,12,1,100,0)=" F TIUI=2:1 D Q:TIUI'<$L(TEXT,"" "")"
|
---|
| 1541 | ^MAGD(2006.79,12,1,101,0)=" . S:$L($G(TIUX(LINE))_"" ""_$P(TEXT,"" "",TIUI))>LENGTH LINE=LINE+1,TIUY=1"
|
---|
| 1542 | ^MAGD(2006.79,12,1,102,0)=" . S TIUX(LINE)=$G(TIUX(LINE))_$S(+$G(TIUY):"""",1:"" "")_$P(TEXT,"" "",TIUI),TIUY=0"
|
---|
| 1543 | ^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)"
|
---|
| 1544 | ^MAGD(2006.79,12,1,104,0)=" Q TEXT"
|
---|
| 1545 | ^MAGD(2006.79,13,0)="TIUSRVPL^3060410.105553"
|
---|
| 1546 | ^MAGD(2006.79,13,1,0)="^2006.791^36^36"
|
---|
| 1547 | ^MAGD(2006.79,13,1,1,0)="TIUSRVPL ; SLC/JER - RPC's Supporting Links ;4/20/2001 09:46"
|
---|
| 1548 | ^MAGD(2006.79,13,1,2,0)=" ;;1.0;TEXT INTEGRATION UTILITIES;**63,114**;Jun 20, 1997"
|
---|
| 1549 | ^MAGD(2006.79,13,1,3,0)="PUTIMAGE(TIUY,TIUDA,IMGDA) ; Create link Image-to-Document"
|
---|
| 1550 | ^MAGD(2006.79,13,1,4,0)=" N D,D0,DI,DQ,DIC,DA,DIE,DR,X,Y"
|
---|
| 1551 | ^MAGD(2006.79,13,1,5,0)=" I $S('+$G(IMGDA):1,'$D(^MAG(2005,+IMGDA,0)):1,1:0) D Q"
|
---|
| 1552 | ^MAGD(2006.79,13,1,6,0)=" . S TIUY=""0^ Invalid Image Pointer."""
|
---|
| 1553 | ^MAGD(2006.79,13,1,7,0)=" I $S('+$G(TIUDA):1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q"
|
---|
| 1554 | ^MAGD(2006.79,13,1,8,0)=" . S TIUY=""0^ Invalid Document Pointer."""
|
---|
| 1555 | ^MAGD(2006.79,13,1,9,0)=" I $$DUPLINK(TIUDA,IMGDA) S TIUY=""0^ Document already linked to this image."" Q"
|
---|
| 1556 | ^MAGD(2006.79,13,1,10,0)=" S X=""""""""_""`""_TIUDA_"""""""",(DIC,DLAYGO)=8925.91,DIC(0)=""LX"""
|
---|
| 1557 | ^MAGD(2006.79,13,1,11,0)=" D ^DIC I +Y'>0 S TIUY=""0^ Unable to create Image Link"" Q"
|
---|
| 1558 | ^MAGD(2006.79,13,1,12,0)=" S TIUY=+Y"
|
---|
| 1559 | ^MAGD(2006.79,13,1,13,0)=" S DIE=DIC,DR="".02////^S X=IMGDA"" D ^DIE"
|
---|
| 1560 | ^MAGD(2006.79,13,1,14,0)=" Q"
|
---|
| 1561 | ^MAGD(2006.79,13,1,15,0)="DUPLINK(TIUDA,IMGDA) ; identify duplicate links"
|
---|
| 1562 | ^MAGD(2006.79,13,1,16,0)=" Q $S(+$O(^TIU(8925.91,""ADI"",+TIUDA,+IMGDA,0)):1,1:0)"
|
---|
| 1563 | ^MAGD(2006.79,13,1,17,0)="DELIMAGE(TIUY,TIUDA,IMGDA) ; Delete link Image-to-Document"
|
---|
| 1564 | ^MAGD(2006.79,13,1,18,0)=" N TIUI"
|
---|
| 1565 | ^MAGD(2006.79,13,1,19,0)=" I '+$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA,0)) D Q"
|
---|
| 1566 | ^MAGD(2006.79,13,1,20,0)=" . S TIUY=""0^ Document and Image not currently linked."""
|
---|
| 1567 | ^MAGD(2006.79,13,1,21,0)=" S TIUI=0"
|
---|
| 1568 | ^MAGD(2006.79,13,1,22,0)=" F S TIUI=$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA,TIUI)) Q:+TIUI'>0 D"
|
---|
| 1569 | ^MAGD(2006.79,13,1,23,0)=" . N DIDEL,DIE,DA,DR"
|
---|
| 1570 | ^MAGD(2006.79,13,1,24,0)=" . S (DIE,DIDEL)=8925.91,DR="".01///@"",DA=TIUI D ^DIE"
|
---|
| 1571 | ^MAGD(2006.79,13,1,25,0)=" S TIUY=1"
|
---|
| 1572 | ^MAGD(2006.79,13,1,26,0)=" Q"
|
---|
| 1573 | ^MAGD(2006.79,13,1,27,0)="GETILST(TIUY,TIUDA) ; Given a document, get list of associated images"
|
---|
| 1574 | ^MAGD(2006.79,13,1,28,0)=" N IMGDA,TIUI S (IMGDA,TIUI)=0"
|
---|
| 1575 | ^MAGD(2006.79,13,1,29,0)=" F S IMGDA=$O(^TIU(8925.91,""ADI"",TIUDA,IMGDA)) Q:+IMGDA'>0 D"
|
---|
| 1576 | ^MAGD(2006.79,13,1,30,0)=" . S TIUI=TIUI+1,TIUY(TIUI)=IMGDA"
|
---|
| 1577 | ^MAGD(2006.79,13,1,31,0)=" Q"
|
---|
| 1578 | ^MAGD(2006.79,13,1,32,0)="GETDLST(TIUY,IMGDA) ; Given an Image, get list of associated documents"
|
---|
| 1579 | ^MAGD(2006.79,13,1,33,0)=" N TIUDA,TIUI S (TIUDA,TIUI)=0"
|
---|
| 1580 | ^MAGD(2006.79,13,1,34,0)=" F S TIUDA=$O(^TIU(8925.91,""AID"",IMGDA,TIUDA)) Q:+TIUDA'>0 D"
|
---|
| 1581 | ^MAGD(2006.79,13,1,35,0)=" . S TIUI=TIUI+1,TIUY(TIUI)=TIUDA"
|
---|
| 1582 | ^MAGD(2006.79,13,1,36,0)=" Q"
|
---|
| 1583 | ^MAGD(2006.79,14,0)="VADPT^3060410.105553"
|
---|
| 1584 | ^MAGD(2006.79,14,1,0)="^2006.791^106^106"
|
---|
| 1585 | ^MAGD(2006.79,14,1,1,0)="VADPT ;ALB/MRL/MJK - RETURN PATIENT VARIABLE ARRAYS [DRIVER];07 DEC 1988"
|
---|
| 1586 | ^MAGD(2006.79,14,1,2,0)=" ;;5.3;Registration;**193,343,389,415,489,498**;Aug 13, 1993"
|
---|
| 1587 | ^MAGD(2006.79,14,1,3,0)=" ;DFN = Patient IFN [if not passed entire array returned as null]"
|
---|
| 1588 | ^MAGD(2006.79,14,1,4,0)=" ;"
|
---|
| 1589 | ^MAGD(2006.79,14,1,5,0)="DEM ;Demographic Variables"
|
---|
| 1590 | ^MAGD(2006.79,14,1,6,0)=" S VAN=1,VAN(1)=12,VAV=""VADM"" D ^VADPT0 Q"
|
---|
| 1591 | ^MAGD(2006.79,14,1,7,0)=" ;"
|
---|
| 1592 | ^MAGD(2006.79,14,1,8,0)="OPD ;Other Patient Data"
|
---|
| 1593 | ^MAGD(2006.79,14,1,9,0)=" S VAN=2,VAN(1)=7,VAV=""VAPD"" D ^VADPT0 Q"
|
---|
| 1594 | ^MAGD(2006.79,14,1,10,0)=" ;"
|
---|
| 1595 | ^MAGD(2006.79,14,1,11,0)="ADD ;Current Address"
|
---|
| 1596 | ^MAGD(2006.79,14,1,12,0)=" S VAN=3,VAN(1)=22,VAV=""VAPA"" D ^VADPT0 Q"
|
---|
| 1597 | ^MAGD(2006.79,14,1,13,0)=" ;"
|
---|
| 1598 | ^MAGD(2006.79,14,1,14,0)="OAD ;Other Patient Variables"
|
---|
| 1599 | ^MAGD(2006.79,14,1,15,0)=" S VAN=4,VAN(1)=11,VAV=""VAOA"" D ^VADPT0 Q"
|
---|
| 1600 | ^MAGD(2006.79,14,1,16,0)=" ;"
|
---|
| 1601 | ^MAGD(2006.79,14,1,17,0)="INP ;Inpatient Data [pre-version 5]"
|
---|
| 1602 | ^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"
|
---|
| 1603 | ^MAGD(2006.79,14,1,19,0)=" ;"
|
---|
| 1604 | ^MAGD(2006.79,14,1,20,0)="IN5 ;Inpatient Data [v5.0 and above]"
|
---|
| 1605 | ^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"
|
---|
| 1606 | ^MAGD(2006.79,14,1,22,0)=" ;"
|
---|
| 1607 | ^MAGD(2006.79,14,1,23,0)="ELIG ;Eligibility Information"
|
---|
| 1608 | ^MAGD(2006.79,14,1,24,0)=" S VAN=7,VAN(1)=9,VAV=""VAEL"" D ^VADPT0 Q"
|
---|
| 1609 | ^MAGD(2006.79,14,1,25,0)=" ;"
|
---|
| 1610 | ^MAGD(2006.79,14,1,26,0)="MB ;Monetary Benefits"
|
---|
| 1611 | ^MAGD(2006.79,14,1,27,0)=" S VAN=8,VAN(1)=9,VAV=""VAMB"" D ^VADPT0 Q"
|
---|
| 1612 | ^MAGD(2006.79,14,1,28,0)=" ;"
|
---|
| 1613 | ^MAGD(2006.79,14,1,29,0)="SVC ;Service Information"
|
---|
| 1614 | ^MAGD(2006.79,14,1,30,0)=" S VAN=9,VAN(1)=9,VAV=""VASV"" D ^VADPT0 Q"
|
---|
| 1615 | ^MAGD(2006.79,14,1,31,0)=" ;"
|
---|
| 1616 | ^MAGD(2006.79,14,1,32,0)="REG ;Registration data"
|
---|
| 1617 | ^MAGD(2006.79,14,1,33,0)=" S VAN=10,VAV=""VARP"" D ^VADPT0 Q"
|
---|
| 1618 | ^MAGD(2006.79,14,1,34,0)=" ;"
|
---|
| 1619 | ^MAGD(2006.79,14,1,35,0)="SDE ;Enrollment Information"
|
---|
| 1620 | ^MAGD(2006.79,14,1,36,0)=" S VAN=11,VAV=""VAEN"" D ^VADPT0 Q"
|
---|
| 1621 | ^MAGD(2006.79,14,1,37,0)=" ;"
|
---|
| 1622 | ^MAGD(2006.79,14,1,38,0)="SDA ;Appointment Information"
|
---|
| 1623 | ^MAGD(2006.79,14,1,39,0)=" S VAN=12,VAV=""VASD"" D ^VADPT0 Q"
|
---|
| 1624 | ^MAGD(2006.79,14,1,40,0)=" ;"
|
---|
| 1625 | ^MAGD(2006.79,14,1,41,0)="PID ;Patient Id"
|
---|
| 1626 | ^MAGD(2006.79,14,1,42,0)=" S VAN=13,VAV=""VA"" D ^VADPT0 Q"
|
---|
| 1627 | ^MAGD(2006.79,14,1,43,0)=" ;"
|
---|
| 1628 | ^MAGD(2006.79,14,1,44,0)="TESTPAT(DFN) ;Test patient ? Returns 0 (No) or 1 (Yes)"
|
---|
| 1629 | ^MAGD(2006.79,14,1,45,0)=" S DFN=+$G(DFN) I 'DFN Q 0"
|
---|
| 1630 | ^MAGD(2006.79,14,1,46,0)=" I $D(^DPT(""ATEST"",DFN)) Q 1"
|
---|
| 1631 | ^MAGD(2006.79,14,1,47,0)=" N NODE S NODE=$G(^DPT(DFN,0))"
|
---|
| 1632 | ^MAGD(2006.79,14,1,48,0)=" I $P(NODE,""^"",21)=1 Q 1"
|
---|
| 1633 | ^MAGD(2006.79,14,1,49,0)=" I $E($P(NODE,""^"",9),1,5)=""00000"" Q 1"
|
---|
| 1634 | ^MAGD(2006.79,14,1,50,0)=" Q 0"
|
---|
| 1635 | ^MAGD(2006.79,14,1,51,0)=" ;"
|
---|
| 1636 | ^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"
|
---|
| 1637 | ^MAGD(2006.79,14,1,53,0)="OERR ;"
|
---|
| 1638 | ^MAGD(2006.79,14,1,54,0)="1 S VATAG=1 D MULT Q"
|
---|
| 1639 | ^MAGD(2006.79,14,1,55,0)="2 S VATAG=2 D MULT Q"
|
---|
| 1640 | ^MAGD(2006.79,14,1,56,0)="3 S VATAG=3 D MULT Q"
|
---|
| 1641 | ^MAGD(2006.79,14,1,57,0)="4 S VATAG=4 D MULT Q"
|
---|
| 1642 | ^MAGD(2006.79,14,1,58,0)="5 S VATAG=5 D MULT Q"
|
---|
| 1643 | ^MAGD(2006.79,14,1,59,0)="6 S VATAG=6 D MULT Q"
|
---|
| 1644 | ^MAGD(2006.79,14,1,60,0)="7 S VATAG=7 D MULT Q"
|
---|
| 1645 | ^MAGD(2006.79,14,1,61,0)="8 S VATAG=8 D MULT Q"
|
---|
| 1646 | ^MAGD(2006.79,14,1,62,0)="9 S VATAG=9 D MULT Q"
|
---|
| 1647 | ^MAGD(2006.79,14,1,63,0)="10 S VATAG=10 D MULT Q"
|
---|
| 1648 | ^MAGD(2006.79,14,1,64,0)="51 S VATAG=11 D MULT Q"
|
---|
| 1649 | ^MAGD(2006.79,14,1,65,0)="52 S VATAG=12 D MULT Q"
|
---|
| 1650 | ^MAGD(2006.79,14,1,66,0)="53 S VATAG=13 D MULT Q"
|
---|
| 1651 | ^MAGD(2006.79,14,1,67,0)="ALL S VATAG=14 D MULT Q"
|
---|
| 1652 | ^MAGD(2006.79,14,1,68,0)="A5 S VATAG=15 D MULT Q"
|
---|
| 1653 | ^MAGD(2006.79,14,1,69,0)="SEL Q:$O(VARRAY(0))']"""" S VATAG=0,VATAG(2)=$P($T(TAG),"";;"",2)"
|
---|
| 1654 | ^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"
|
---|
| 1655 | ^MAGD(2006.79,14,1,71,0)=" G Q"
|
---|
| 1656 | ^MAGD(2006.79,14,1,72,0)=" ;"
|
---|
| 1657 | ^MAGD(2006.79,14,1,73,0)="MULT S VATAG=$P($T(TG+VATAG),"";;"",2)"
|
---|
| 1658 | ^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))"
|
---|
| 1659 | ^MAGD(2006.79,14,1,75,0)="Q S VAROOT="""" K:$D(VAROOT)'=11 VAROOT K VATAG Q"
|
---|
| 1660 | ^MAGD(2006.79,14,1,76,0)=" ;"
|
---|
| 1661 | ^MAGD(2006.79,14,1,77,0)="KVA K VA"
|
---|
| 1662 | ^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"
|
---|
| 1663 | ^MAGD(2006.79,14,1,79,0)="DATIM(DATIM) ;If time not specified see if movement on that date"
|
---|
| 1664 | ^MAGD(2006.79,14,1,80,0)=" Q:DATIM'?7N DATIM"
|
---|
| 1665 | ^MAGD(2006.79,14,1,81,0)=" N A,B S A=$O(^DGPM(""ADFN""_DFN,DATIM)),B=+$O(^(+A,0))"
|
---|
| 1666 | ^MAGD(2006.79,14,1,82,0)=" I 'A Q DATIM"
|
---|
| 1667 | ^MAGD(2006.79,14,1,83,0)=" I $P($G(^DGPM(+B,0)),""^"",2)=3 Q DATIM ;Next movement is discharge"
|
---|
| 1668 | ^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"
|
---|
| 1669 | ^MAGD(2006.79,14,1,85,0)=" I 'A Q DATIM"
|
---|
| 1670 | ^MAGD(2006.79,14,1,86,0)=" I $E(A,1,7)'=DATIM Q DATIM"
|
---|
| 1671 | ^MAGD(2006.79,14,1,87,0)=" Q A"
|
---|
| 1672 | ^MAGD(2006.79,14,1,88,0)=" ;"
|
---|
| 1673 | ^MAGD(2006.79,14,1,89,0)="TG ;"
|
---|
| 1674 | ^MAGD(2006.79,14,1,90,0)=" ;;DEM^INP"
|
---|
| 1675 | ^MAGD(2006.79,14,1,91,0)=" ;;DEM^ELIG"
|
---|
| 1676 | ^MAGD(2006.79,14,1,92,0)=" ;;ELIG^INP"
|
---|
| 1677 | ^MAGD(2006.79,14,1,93,0)=" ;;DEM^ADD"
|
---|
| 1678 | ^MAGD(2006.79,14,1,94,0)=" ;;ADD^INP"
|
---|
| 1679 | ^MAGD(2006.79,14,1,95,0)=" ;;DEM^ELIG^ADD"
|
---|
| 1680 | ^MAGD(2006.79,14,1,96,0)=" ;;ELIG^SVC"
|
---|
| 1681 | ^MAGD(2006.79,14,1,97,0)=" ;;ELIG^SVC^MB"
|
---|
| 1682 | ^MAGD(2006.79,14,1,98,0)=" ;;DEM^REG^SDE^SDA"
|
---|
| 1683 | ^MAGD(2006.79,14,1,99,0)=" ;;SDE^SDA"
|
---|
| 1684 | ^MAGD(2006.79,14,1,100,0)=" ;;DEM^IN5"
|
---|
| 1685 | ^MAGD(2006.79,14,1,101,0)=" ;;ELIG^IN5"
|
---|
| 1686 | ^MAGD(2006.79,14,1,102,0)=" ;;ADD^IN5"
|
---|
| 1687 | ^MAGD(2006.79,14,1,103,0)=" ;;DEM^OPD^INP^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA"
|
---|
| 1688 | ^MAGD(2006.79,14,1,104,0)=" ;;DEM^OPD^IN5^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA"
|
---|
| 1689 | ^MAGD(2006.79,14,1,105,0)=" ;"
|
---|
| 1690 | ^MAGD(2006.79,14,1,106,0)="TAG ;;^DEM^OPD^INP^IN5^ADD^OAD^ELIG^SVC^MB^REG^SDE^SDA^"
|
---|
| 1691 | ^MAGD(2006.79,15,0)="VADPT0^3060410.105553"
|
---|
| 1692 | ^MAGD(2006.79,15,1,0)="^2006.791^100^100"
|
---|
| 1693 | ^MAGD(2006.79,15,1,1,0)="VADPT0 ;ALB/MRL/MJK - PATIENT VARIABLE ROUTINE DRIVER, CONT.; 12 DEC 1988"
|
---|
| 1694 | ^MAGD(2006.79,15,1,2,0)=" ;;5.3;Registration;**343,342,415,489,498,528**;Aug 13, 1993"
|
---|
| 1695 | ^MAGD(2006.79,15,1,3,0)=" ;"
|
---|
| 1696 | ^MAGD(2006.79,15,1,4,0)=" ;Initialize variables"
|
---|
| 1697 | ^MAGD(2006.79,15,1,5,0)=" N I1"
|
---|
| 1698 | ^MAGD(2006.79,15,1,6,0)=" S U=""^"" D DT^DICRW:'$D(DT)"
|
---|
| 1699 | ^MAGD(2006.79,15,1,7,0)=" S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(DFN,0)):1,1:0)"
|
---|
| 1700 | ^MAGD(2006.79,15,1,8,0)=" S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"""" S Y=0,VAV=VAROOT K @VAV"
|
---|
| 1701 | ^MAGD(2006.79,15,1,9,0)=" I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV=""^UTILITY(""_""""""""_VAV_""""""""_"",""_$J_"")"""
|
---|
| 1702 | ^MAGD(2006.79,15,1,10,0)=" D @VAN"
|
---|
| 1703 | ^MAGD(2006.79,15,1,11,0)="Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q"
|
---|
| 1704 | ^MAGD(2006.79,15,1,12,0)=" ;"
|
---|
| 1705 | ^MAGD(2006.79,15,1,13,0)="INIT ; -- determine #'s or names then init array"
|
---|
| 1706 | ^MAGD(2006.79,15,1,14,0)=" ;"
|
---|
| 1707 | ^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"""
|
---|
| 1708 | ^MAGD(2006.79,15,1,16,0)=" I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),"";;"",2)"
|
---|
| 1709 | ^MAGD(2006.79,15,1,17,0)=" I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,""^"",I))="""""
|
---|
| 1710 | ^MAGD(2006.79,15,1,18,0)=" Q"
|
---|
| 1711 | ^MAGD(2006.79,15,1,19,0)=" ;"
|
---|
| 1712 | ^MAGD(2006.79,15,1,20,0)="1 ; -- [DEM] demos "
|
---|
| 1713 | ^MAGD(2006.79,15,1,21,0)=" D C1,INIT I 'VAERR D 1^VADPT1,13 Q"
|
---|
| 1714 | ^MAGD(2006.79,15,1,22,0)=" ;"
|
---|
| 1715 | ^MAGD(2006.79,15,1,23,0)="2 ; -- [OPD] other pt vars"
|
---|
| 1716 | ^MAGD(2006.79,15,1,24,0)=" D C2,INIT,2^VADPT1:'VAERR Q"
|
---|
| 1717 | ^MAGD(2006.79,15,1,25,0)=" ;"
|
---|
| 1718 | ^MAGD(2006.79,15,1,26,0)="3 ; -- [ADD] current address"
|
---|
| 1719 | ^MAGD(2006.79,15,1,27,0)=" D C3,INIT,3^VADPT1:'VAERR Q"
|
---|
| 1720 | ^MAGD(2006.79,15,1,28,0)=" ;"
|
---|
| 1721 | ^MAGD(2006.79,15,1,29,0)="4 ; -- [OAD] other pt vars"
|
---|
| 1722 | ^MAGD(2006.79,15,1,30,0)=" D C4,INIT,4^VADPT1:'VAERR Q"
|
---|
| 1723 | ^MAGD(2006.79,15,1,31,0)=" ;"
|
---|
| 1724 | ^MAGD(2006.79,15,1,32,0)="5 ; -- [INP] inpt data -v5"
|
---|
| 1725 | ^MAGD(2006.79,15,1,33,0)=" D C5,INIT,5^VADPT2:'VAERR Q"
|
---|
| 1726 | ^MAGD(2006.79,15,1,34,0)=" ;"
|
---|
| 1727 | ^MAGD(2006.79,15,1,35,0)="6 ; -- [IN5] inpt data v5"
|
---|
| 1728 | ^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)="""""
|
---|
| 1729 | ^MAGD(2006.79,15,1,37,0)=" F I=1:1:3 S @VAV@($P(VAS,""^"",19),I)="""""
|
---|
| 1730 | ^MAGD(2006.79,15,1,38,0)=" D 6^VADPT3:'VAERR Q"
|
---|
| 1731 | ^MAGD(2006.79,15,1,39,0)=" ;"
|
---|
| 1732 | ^MAGD(2006.79,15,1,40,0)="7 ; -- [ELIG] elig data"
|
---|
| 1733 | ^MAGD(2006.79,15,1,41,0)=" D C7,INIT F I=1:1:6 S @VAV@($P(VAS,""^"",5),I)="""""
|
---|
| 1734 | ^MAGD(2006.79,15,1,42,0)=" D 7^VADPT4:'VAERR Q"
|
---|
| 1735 | ^MAGD(2006.79,15,1,43,0)=" ;"
|
---|
| 1736 | ^MAGD(2006.79,15,1,44,0)="8 ; -- [MB] $ benefits"
|
---|
| 1737 | ^MAGD(2006.79,15,1,45,0)=" D C8,INIT D 8^VADPT4:'VAERR Q"
|
---|
| 1738 | ^MAGD(2006.79,15,1,46,0)=" ;"
|
---|
| 1739 | ^MAGD(2006.79,15,1,47,0)="9 ; -- [SVC] service data"
|
---|
| 1740 | ^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)="""""
|
---|
| 1741 | ^MAGD(2006.79,15,1,49,0)=" S @VAV@($P(VAS,""^"",10),1)="""""
|
---|
| 1742 | ^MAGD(2006.79,15,1,50,0)=" S @VAV@($P(VAS,""^"",4),3)="""",@VAV@($P(VAS,""^"",5),3)="""""
|
---|
| 1743 | ^MAGD(2006.79,15,1,51,0)=" F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,""^"",I),I1)="""""
|
---|
| 1744 | ^MAGD(2006.79,15,1,52,0)=" D 9^VADPT4:'VAERR Q"
|
---|
| 1745 | ^MAGD(2006.79,15,1,53,0)=" ;"
|
---|
| 1746 | ^MAGD(2006.79,15,1,54,0)="10 ; -- [REG] registration data"
|
---|
| 1747 | ^MAGD(2006.79,15,1,55,0)=" D C10,INIT D 10^VADPT5:'VAERR Q"
|
---|
| 1748 | ^MAGD(2006.79,15,1,56,0)=" ;"
|
---|
| 1749 | ^MAGD(2006.79,15,1,57,0)="11 ; -- [SDE] clinic enrollment data"
|
---|
| 1750 | ^MAGD(2006.79,15,1,58,0)=" D C11,INIT D 11^VADPT5:'VAERR Q"
|
---|
| 1751 | ^MAGD(2006.79,15,1,59,0)=" ;"
|
---|
| 1752 | ^MAGD(2006.79,15,1,60,0)="12 ; -- [SDA] appt data"
|
---|
| 1753 | ^MAGD(2006.79,15,1,61,0)=" D C12,INIT D 12^VADPT5:'VAERR Q"
|
---|
| 1754 | ^MAGD(2006.79,15,1,62,0)=" ;"
|
---|
| 1755 | ^MAGD(2006.79,15,1,63,0)="13 ; -- [PID] pt id's"
|
---|
| 1756 | ^MAGD(2006.79,15,1,64,0)=" S (VA(""PID""),VA(""BID""))="""" D 13^VADPT6:'VAERR Q"
|
---|
| 1757 | ^MAGD(2006.79,15,1,65,0)=" ;"
|
---|
| 1758 | ^MAGD(2006.79,15,1,66,0)="KVAR ; kill all vadpt data"
|
---|
| 1759 | ^MAGD(2006.79,15,1,67,0)=" K VAN"
|
---|
| 1760 | ^MAGD(2006.79,15,1,68,0)="C1 K ^UTILITY(""VADM"",$J),VADM Q:$D(VAN)"
|
---|
| 1761 | ^MAGD(2006.79,15,1,69,0)="C2 K ^UTILITY(""VAPD"",$J),VAPD Q:$D(VAN)"
|
---|
| 1762 | ^MAGD(2006.79,15,1,70,0)="C3 K X S:$D(VAPA(""P"")) X(""P"")=VAPA(""P"")"
|
---|
| 1763 | ^MAGD(2006.79,15,1,71,0)=" S:$D(VAPA(""CD"")) X(""CD"")=VAPA(""CD"")"
|
---|
| 1764 | ^MAGD(2006.79,15,1,72,0)=" K ^UTILITY(""VAPA"",$J),VAPA"
|
---|
| 1765 | ^MAGD(2006.79,15,1,73,0)=" S:$D(X(""P"")) VAPA(""P"")=X(""P"") K X(""P"")"
|
---|
| 1766 | ^MAGD(2006.79,15,1,74,0)=" S:$D(X(""CD"")) VAPA(""CD"")=X(""CD"") K X Q:$D(VAN)"
|
---|
| 1767 | ^MAGD(2006.79,15,1,75,0)="C4 K X S:$D(VAOA(""A"")) X(""A"")=VAOA(""A"")"
|
---|
| 1768 | ^MAGD(2006.79,15,1,76,0)=" K ^UTILITY(""VAOA"",$J),VAOA"
|
---|
| 1769 | ^MAGD(2006.79,15,1,77,0)=" S:$D(X(""A"")) VAOA(""A"")=X(""A"") K X Q:$D(VAN)"
|
---|
| 1770 | ^MAGD(2006.79,15,1,78,0)="C5 K ^UTILITY(""VAIN"",$J),VAIN Q:$D(VAN)"
|
---|
| 1771 | ^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)"
|
---|
| 1772 | ^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"
|
---|
| 1773 | ^MAGD(2006.79,15,1,81,0)=" F I=""D"",""E"",""L"",""M"",""V"" I $D(X(I)) S VAIP(I)=X(I)"
|
---|
| 1774 | ^MAGD(2006.79,15,1,82,0)=" K X Q:$D(VAN)"
|
---|
| 1775 | ^MAGD(2006.79,15,1,83,0)="C7 K ^UTILITY(""VAEL"",$J),VAEL Q:$D(VAN)"
|
---|
| 1776 | ^MAGD(2006.79,15,1,84,0)="C8 K ^UTILITY(""VAMB"",$J),VAMB Q:$D(VAN)"
|
---|
| 1777 | ^MAGD(2006.79,15,1,85,0)="C9 K ^UTILITY(""VASV"",$J),VASV Q:$D(VAN)"
|
---|
| 1778 | ^MAGD(2006.79,15,1,86,0)="C10 K ^UTILITY(""VARP"",$J) Q:$D(VAN)"
|
---|
| 1779 | ^MAGD(2006.79,15,1,87,0)="C11 K ^UTILITY(""VAEN"",$J) Q:$D(VAN)"
|
---|
| 1780 | ^MAGD(2006.79,15,1,88,0)="C12 K ^UTILITY(""VASD"",$J) Q"
|
---|
| 1781 | ^MAGD(2006.79,15,1,89,0)="C13 Q"
|
---|
| 1782 | ^MAGD(2006.79,15,1,90,0)=" ;"
|
---|
| 1783 | ^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"
|
---|
| 1784 | ^MAGD(2006.79,15,1,92,0)=" ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC"
|
---|
| 1785 | ^MAGD(2006.79,15,1,93,0)=" ;;BC^BS^FN^MN^MM^OC^ES"
|
---|
| 1786 | ^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"
|
---|
| 1787 | ^MAGD(2006.79,15,1,95,0)=" ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4"
|
---|
| 1788 | ^MAGD(2006.79,15,1,96,0)=" ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP"
|
---|
| 1789 | ^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"
|
---|
| 1790 | ^MAGD(2006.79,15,1,98,0)=" ;;EL^PS^SC^VT^IN^TY^CN^ES^MT"
|
---|
| 1791 | ^MAGD(2006.79,15,1,99,0)=" ;;AA^HB^SS^PE^MR^SI^DI^OR^GI"
|
---|
| 1792 | ^MAGD(2006.79,15,1,100,0)=" ;;VN^AO^IR^PW^CS^S1^S2^S3^PH"
|
---|
| 1793 | ^MAGD(2006.79,16,0)="VADPT1^3060410.105553"
|
---|
| 1794 | ^MAGD(2006.79,16,1,0)="^2006.791^126^126"
|
---|
| 1795 | ^MAGD(2006.79,16,1,1,0)="VADPT1 ;ALB/MRL/MJK - PATIENT VARIABLES ; 08 DEC 1988 ; 11/9/04 6:17pm"
|
---|
| 1796 | ^MAGD(2006.79,16,1,2,0)=" ;;5.3;Registration;**415,489,516,614**;Aug 13, 1993"
|
---|
| 1797 | ^MAGD(2006.79,16,1,3,0)="1 ;Demographic [DEM]"
|
---|
| 1798 | ^MAGD(2006.79,16,1,4,0)=" N W,Z,NODE"
|
---|
| 1799 | ^MAGD(2006.79,16,1,5,0)=" ;"
|
---|
| 1800 | ^MAGD(2006.79,16,1,6,0)=" ; -- name [1 - NM]"
|
---|
| 1801 | ^MAGD(2006.79,16,1,7,0)=" S VAX=^DPT(DFN,0),@VAV@($P(VAS,""^"",1))=$P(VAX,""^"")"
|
---|
| 1802 | ^MAGD(2006.79,16,1,8,0)=" ;"
|
---|
| 1803 | ^MAGD(2006.79,16,1,9,0)=" ; -- ssn [2 - SS]"
|
---|
| 1804 | ^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:"""")"
|
---|
| 1805 | ^MAGD(2006.79,16,1,11,0)=" ;"
|
---|
| 1806 | ^MAGD(2006.79,16,1,12,0)=" ; -- date of birth [2 - DB]"
|
---|
| 1807 | ^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"
|
---|
| 1808 | ^MAGD(2006.79,16,1,14,0)=" ;"
|
---|
| 1809 | ^MAGD(2006.79,16,1,15,0)=" ; -- age [4 - AG]"
|
---|
| 1810 | ^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))"
|
---|
| 1811 | ^MAGD(2006.79,16,1,17,0)=" ;"
|
---|
| 1812 | ^MAGD(2006.79,16,1,18,0)=" ; -- expired date [6 - EX]"
|
---|
| 1813 | ^MAGD(2006.79,16,1,19,0)=" S (Y,Z)=W X:Y]"""" ^DD(""DD"") S:Z]"""" @VAV@($P(VAS,""^"",6))=Z_""^""_Y"
|
---|
| 1814 | ^MAGD(2006.79,16,1,20,0)=" ;"
|
---|
| 1815 | ^MAGD(2006.79,16,1,21,0)=" ; -- sex [5 - SX]"
|
---|
| 1816 | ^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"
|
---|
| 1817 | ^MAGD(2006.79,16,1,23,0)=" ;"
|
---|
| 1818 | ^MAGD(2006.79,16,1,24,0)=" ; -- remarks [7 - RE]"
|
---|
| 1819 | ^MAGD(2006.79,16,1,25,0)=" S @VAV@($P(VAS,""^"",7))=$P(VAX,""^"",10)"
|
---|
| 1820 | ^MAGD(2006.79,16,1,26,0)=" ;"
|
---|
| 1821 | ^MAGD(2006.79,16,1,27,0)=" ; -- historic race [8 - RA]"
|
---|
| 1822 | ^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:"""")"
|
---|
| 1823 | ^MAGD(2006.79,16,1,29,0)=" ;"
|
---|
| 1824 | ^MAGD(2006.79,16,1,30,0)=" ; -- religion [9 - RP]"
|
---|
| 1825 | ^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:"""")"
|
---|
| 1826 | ^MAGD(2006.79,16,1,32,0)=" ;"
|
---|
| 1827 | ^MAGD(2006.79,16,1,33,0)=" ; -- marital status [10 - MS]"
|
---|
| 1828 | ^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:"""")"
|
---|
| 1829 | ^MAGD(2006.79,16,1,35,0)=" ;"
|
---|
| 1830 | ^MAGD(2006.79,16,1,36,0)=" ; -- ethnicity [11 - ET]"
|
---|
| 1831 | ^MAGD(2006.79,16,1,37,0)=" S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.06,X)) Q:'X D"
|
---|
| 1832 | ^MAGD(2006.79,16,1,38,0)=" .S NODE=$G(^DPT(DFN,.06,X,0)),Z=$P(NODE,""^"",1) I Z D"
|
---|
| 1833 | ^MAGD(2006.79,16,1,39,0)=" ..S @VAV@($P(VAS,""^"",11),Y)=Z_""^""_$P($G(^DIC(10.2,Z,0)),""^"",1)"
|
---|
| 1834 | ^MAGD(2006.79,16,1,40,0)=" ..; -- collection method"
|
---|
| 1835 | ^MAGD(2006.79,16,1,41,0)=" ..S Z=$P(NODE,""^"",2) I Z D"
|
---|
| 1836 | ^MAGD(2006.79,16,1,42,0)=" ...S @VAV@($P(VAS,""^"",11),Y,1)=Z_""^""_$P($G(^DIC(10.3,Z,0)),""^"",1)"
|
---|
| 1837 | ^MAGD(2006.79,16,1,43,0)=" S @VAV@($P(VAS,""^"",11))=Y-1"
|
---|
| 1838 | ^MAGD(2006.79,16,1,44,0)=" ;"
|
---|
| 1839 | ^MAGD(2006.79,16,1,45,0)=" ; -- race [12 - RC]"
|
---|
| 1840 | ^MAGD(2006.79,16,1,46,0)=" S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.02,X)) Q:'X D"
|
---|
| 1841 | ^MAGD(2006.79,16,1,47,0)=" .S NODE=$G(^DPT(DFN,.02,X,0)),Z=$P(NODE,""^"",1) I Z D"
|
---|
| 1842 | ^MAGD(2006.79,16,1,48,0)=" ..S @VAV@($P(VAS,""^"",12),Y)=Z_""^""_$P($G(^DIC(10,Z,0)),""^"",1)"
|
---|
| 1843 | ^MAGD(2006.79,16,1,49,0)=" ..; -- collection method"
|
---|
| 1844 | ^MAGD(2006.79,16,1,50,0)=" ..S Z=$P(NODE,""^"",2) I Z D"
|
---|
| 1845 | ^MAGD(2006.79,16,1,51,0)=" ...S @VAV@($P(VAS,""^"",12),Y,1)=Z_""^""_$P($G(^DIC(10.3,Z,0)),""^"",1)"
|
---|
| 1846 | ^MAGD(2006.79,16,1,52,0)=" S @VAV@($P(VAS,""^"",12))=Y-1"
|
---|
| 1847 | ^MAGD(2006.79,16,1,53,0)=" Q"
|
---|
| 1848 | ^MAGD(2006.79,16,1,54,0)=" ;"
|
---|
| 1849 | ^MAGD(2006.79,16,1,55,0)="2 ;Other Patient Variables [OPD]"
|
---|
| 1850 | ^MAGD(2006.79,16,1,56,0)=" N W,Z"
|
---|
| 1851 | ^MAGD(2006.79,16,1,57,0)=" S VAX=^DPT(DFN,0)"
|
---|
| 1852 | ^MAGD(2006.79,16,1,58,0)=" ;"
|
---|
| 1853 | ^MAGD(2006.79,16,1,59,0)=" ; -- city of birth [1 - BC]"
|
---|
| 1854 | ^MAGD(2006.79,16,1,60,0)=" S @VAV@($P(VAS,""^"",1))=$P(VAX,""^"",11)"
|
---|
| 1855 | ^MAGD(2006.79,16,1,61,0)=" ;"
|
---|
| 1856 | ^MAGD(2006.79,16,1,62,0)=" ; -- state of birth [2 - BS]"
|
---|
| 1857 | ^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:"""")"
|
---|
| 1858 | ^MAGD(2006.79,16,1,64,0)=" ;"
|
---|
| 1859 | ^MAGD(2006.79,16,1,65,0)=" ; -- occupation [6 - OC]"
|
---|
| 1860 | ^MAGD(2006.79,16,1,66,0)=" S @VAV@($P(VAS,""^"",6))=$P(VAX,""^"",7)"
|
---|
| 1861 | ^MAGD(2006.79,16,1,67,0)=" ;"
|
---|
| 1862 | ^MAGD(2006.79,16,1,68,0)=" ; -- names"
|
---|
| 1863 | ^MAGD(2006.79,16,1,69,0)=" S VAX=$S($D(^DPT(DFN,.24)):^(.24),1:"""")"
|
---|
| 1864 | ^MAGD(2006.79,16,1,70,0)=" S @VAV@($P(VAS,""^"",3))=$P(VAX,""^"",1) ; father's [3 - FN]"
|
---|
| 1865 | ^MAGD(2006.79,16,1,71,0)=" S @VAV@($P(VAS,""^"",4))=$P(VAX,""^"",2) ; mother's [4 - MN]"
|
---|
| 1866 | ^MAGD(2006.79,16,1,72,0)=" S @VAV@($P(VAS,""^"",5))=$P(VAX,""^"",3) ; mother's maiden [5 - MM]"
|
---|
| 1867 | ^MAGD(2006.79,16,1,73,0)=" ;"
|
---|
| 1868 | ^MAGD(2006.79,16,1,74,0)=" ; -- employment status [7 - ES]"
|
---|
| 1869 | ^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"""
|
---|
| 1870 | ^MAGD(2006.79,16,1,76,0)=" S Z=$P(VAX,""^"",15),@VAV@($P(VAS,""^"",7))=Z_$S(Z:""^""_$P(W,""^"",Z),1:"""")"
|
---|
| 1871 | ^MAGD(2006.79,16,1,77,0)=" Q"
|
---|
| 1872 | ^MAGD(2006.79,16,1,78,0)=" ;"
|
---|
| 1873 | ^MAGD(2006.79,16,1,79,0)="3 ;Address [ADD]"
|
---|
| 1874 | ^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)"
|
---|
| 1875 | ^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"
|
---|
| 1876 | ^MAGD(2006.79,16,1,82,0)=" E S VAX=$S($D(^DPT(DFN,.121)):^(.121),1:""""),VAX(1)=1"
|
---|
| 1877 | ^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"
|
---|
| 1878 | ^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"
|
---|
| 1879 | ^MAGD(2006.79,16,1,85,0)=" S VAZIP4=$P(VAX,U,12)"
|
---|
| 1880 | ^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))"
|
---|
| 1881 | ^MAGD(2006.79,16,1,87,0)=" ;DG*5.3*516"
|
---|
| 1882 | ^MAGD(2006.79,16,1,88,0)=" I $D(^DPT(DFN,.13)) S @VAV@($P(VAS,""^"",8))=$P(^(.13),""^"",1)"
|
---|
| 1883 | ^MAGD(2006.79,16,1,89,0)=" I 'VAX(1) G CA"
|
---|
| 1884 | ^MAGD(2006.79,16,1,90,0)=" S @VAV@($P(VAS,""^"",8))=$P(VAX,""^"",10)"
|
---|
| 1885 | ^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"
|
---|
| 1886 | ^MAGD(2006.79,16,1,92,0)="CA ;Confidential Address"
|
---|
| 1887 | ^MAGD(2006.79,16,1,93,0)=" I '$D(^DPT(DFN,.141)) G Q3"
|
---|
| 1888 | ^MAGD(2006.79,16,1,94,0)=" N VACAT,VAACT,VAACTDT,VATYP,VATYPNAM,VACAN"
|
---|
| 1889 | ^MAGD(2006.79,16,1,95,0)=" S VAX=$S($D(^DPT(DFN,.141)):^(.141),1:"""")"
|
---|
| 1890 | ^MAGD(2006.79,16,1,96,0)=" S VAACTDT=$S($D(VAPA(""CD"")):VAPA(""CD""),1:DT)"
|
---|
| 1891 | ^MAGD(2006.79,16,1,97,0)=" F I=1:1:6 S VAZ=$P(VAX,""^"",I),@VAV@($P(VAS,""^"",I+12))=VAZ D"
|
---|
| 1892 | ^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"
|
---|
| 1893 | ^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))"
|
---|
| 1894 | ^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"
|
---|
| 1895 | ^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"
|
---|
| 1896 | ^MAGD(2006.79,16,1,102,0)=" S VABEG=$P(VAX,""^"",7),VAEND=$P(VAX,""^"",8)"
|
---|
| 1897 | ^MAGD(2006.79,16,1,103,0)=" S @VAV@($P(VAS,""^"",12))=1"
|
---|
| 1898 | ^MAGD(2006.79,16,1,104,0)=" I 'VABEG!(VABEG>VAACTDT)!(VAEND&(VAEND<VAACTDT)) S @VAV@($P(VAS,""^"",12))=0"
|
---|
| 1899 | ^MAGD(2006.79,16,1,105,0)=" I $D(^DPT(DFN,.14)) D"
|
---|
| 1900 | ^MAGD(2006.79,16,1,106,0)=" .S VACAN="""" F S VACAN=$O(^DPT(DFN,.14,VACAN)) Q:VACAN="""" D"
|
---|
| 1901 | ^MAGD(2006.79,16,1,107,0)=" ..Q:'$D(^DPT(DFN,.14,VACAN,0))"
|
---|
| 1902 | ^MAGD(2006.79,16,1,108,0)=" ..S VATYP=$P(^DPT(DFN,.14,VACAN,0),""^"",1),VAACT=$P(^DPT(DFN,.14,VACAN,0),""^"",2)"
|
---|
| 1903 | ^MAGD(2006.79,16,1,109,0)=" ..S VACAT=$$GET1^DID(2.141,.01,"""",""POINTER"","""",""DGERR"")"
|
---|
| 1904 | ^MAGD(2006.79,16,1,110,0)=" ..S VATYPNAM="""" F I=1:1 S VATYPNAM=$P(VACAT,"";"",I) Q:VATYPNAM="""" D"
|
---|
| 1905 | ^MAGD(2006.79,16,1,111,0)=" ...I +VATYPNAM[VATYP S VATYPNAM=$P(VATYPNAM,"":"",2),@VAV@($P(VAS,""^"",22),VATYP)=VATYP_""^""_VATYPNAM_""^""_VAACT"
|
---|
| 1906 | ^MAGD(2006.79,16,1,112,0)="Q3 K VABEG,VAEND,VAZIP4 Q"
|
---|
| 1907 | ^MAGD(2006.79,16,1,113,0)=" ;"
|
---|
| 1908 | ^MAGD(2006.79,16,1,114,0)="4 ;Other Address [OAD]"
|
---|
| 1909 | ^MAGD(2006.79,16,1,115,0)=" N VAZIP4"
|
---|
| 1910 | ^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"
|
---|
| 1911 | ^MAGD(2006.79,16,1,117,0)=" E S VAX="".""_$P(""33^34^211^331^311^25"",""^"",+VAOA(""A""))"
|
---|
| 1912 | ^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)"
|
---|
| 1913 | ^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)"
|
---|
| 1914 | ^MAGD(2006.79,16,1,120,0)=" S @VAV@($P(VAS,""^"",7))="""",@VAV@($P(VAS,""^"",8))=$P(VAX,""^"",9),VAX(2)=8"
|
---|
| 1915 | ^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)"
|
---|
| 1916 | ^MAGD(2006.79,16,1,122,0)=" I ""^.311^.25""[(""^""_VAX(1)_""^"") S @VAV@($P(VAS,""^"",10))="""""
|
---|
| 1917 | ^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)"
|
---|
| 1918 | ^MAGD(2006.79,16,1,124,0)=" S VAZIP4=$P($G(^DPT(DFN,.22)),U,VAOA(""A""))"
|
---|
| 1919 | ^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))"
|
---|
| 1920 | ^MAGD(2006.79,16,1,126,0)=" Q"
|
---|
| 1921 | ^MAGD(2006.79,17,0)="VADPT2^3060410.105553"
|
---|
| 1922 | ^MAGD(2006.79,17,1,0)="^2006.791^60^60"
|
---|
| 1923 | ^MAGD(2006.79,17,1,1,0)="VADPT2 ;ALB/MJK - ESTABLISH PATIENT VARIABLES ; 3/23/88 9:13 PM ; [10/20/95 4:02pm]"
|
---|
| 1924 | ^MAGD(2006.79,17,1,2,0)=" ;;5.3;Registration;**69**;Aug 13, 1993"
|
---|
| 1925 | ^MAGD(2006.79,17,1,3,0)="5 ; -- INP call"
|
---|
| 1926 | ^MAGD(2006.79,17,1,4,0)=" S (VAWD,VATS,VADX,VAPP,VAAP,VARM)="""" D NOW^%DTC S VANOW=% K VAMV,VAMV0"
|
---|
| 1927 | ^MAGD(2006.79,17,1,5,0)=" I '$D(VAINDT) N VAINDT S VAINDT=VANOW"
|
---|
| 1928 | ^MAGD(2006.79,17,1,6,0)=" S VATD=9999999.999999-VAINDT"
|
---|
| 1929 | ^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"
|
---|
| 1930 | ^MAGD(2006.79,17,1,8,0)=" ;"
|
---|
| 1931 | ^MAGD(2006.79,17,1,9,0)=" G:'$D(VAMV0) DONE"
|
---|
| 1932 | ^MAGD(2006.79,17,1,10,0)=" S (VAPRT,VAPRC,VACN)=1 D GET^VADPT30"
|
---|
| 1933 | ^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:"""")"
|
---|
| 1934 | ^MAGD(2006.79,17,1,12,0)=" ;"
|
---|
| 1935 | ^MAGD(2006.79,17,1,13,0)=" ; set: adm ifn(1) ; doctor(2) ; tr spec(3) ; ward(4) ; room(5) ; attending (11)"
|
---|
| 1936 | ^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"
|
---|
| 1937 | ^MAGD(2006.79,17,1,15,0)=" ;"
|
---|
| 1938 | ^MAGD(2006.79,17,1,16,0)=" ; set bed/no bed mvt type(6)"
|
---|
| 1939 | ^MAGD(2006.79,17,1,17,0)=" D IB S @VAV@($P(VAS,""^"",6))=VAZ"
|
---|
| 1940 | ^MAGD(2006.79,17,1,18,0)=" ;"
|
---|
| 1941 | ^MAGD(2006.79,17,1,19,0)=" ; set adm date(7)"
|
---|
| 1942 | ^MAGD(2006.79,17,1,20,0)=" S Y=+VACA0 X:Y ^DD(""DD"") S @VAV@($P(VAS,""^"",7))=+VACA0_""^""_Y"
|
---|
| 1943 | ^MAGD(2006.79,17,1,21,0)=" ;"
|
---|
| 1944 | ^MAGD(2006.79,17,1,22,0)=" ; set: adm type(8) ; adm dx(9) ; ptf ifn(10)"
|
---|
| 1945 | ^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)"
|
---|
| 1946 | ^MAGD(2006.79,17,1,24,0)=" ;"
|
---|
| 1947 | ^MAGD(2006.79,17,1,25,0)="DONE K VAID,VANOW,VACA,VACA0,VAMV,VAMV0,VATD,VAMT,VAMVT D KVAR^VADPT30 Q"
|
---|
| 1948 | ^MAGD(2006.79,17,1,26,0)=" ;"
|
---|
| 1949 | ^MAGD(2006.79,17,1,27,0)="IB ;In-Bed status"
|
---|
| 1950 | ^MAGD(2006.79,17,1,28,0)=" ; input: VAINDT = internal date of requested info"
|
---|
| 1951 | ^MAGD(2006.79,17,1,29,0)=" ; VAMV = starting IFN"
|
---|
| 1952 | ^MAGD(2006.79,17,1,30,0)=" ; VAMV0 = 0th of VAMV"
|
---|
| 1953 | ^MAGD(2006.79,17,1,31,0)=" ;"
|
---|
| 1954 | ^MAGD(2006.79,17,1,32,0)=" ; output: VAZ = <O:not in bed OR 1: in bed>^fac. mvt name"
|
---|
| 1955 | ^MAGD(2006.79,17,1,33,0)=" ; VAZ(2) = abs ret date"
|
---|
| 1956 | ^MAGD(2006.79,17,1,34,0)=" ;"
|
---|
| 1957 | ^MAGD(2006.79,17,1,35,0)=" S VAZ=0,VAZ(2)="""""
|
---|
| 1958 | ^MAGD(2006.79,17,1,36,0)=" S VAXI=+$O(^DGPM(""APMV"",DFN,+$P(VAMV0,""^"",14),9999999.999999-VAINDT)),VAXI=+$O(^(VAXI,0))"
|
---|
| 1959 | ^MAGD(2006.79,17,1,37,0)=" I 'VAXI,$D(VAIP(""L"")),$P(VAMV0,""^"",2)=4 S VAXI=VAMV ; only used via IN5"
|
---|
| 1960 | ^MAGD(2006.79,17,1,38,0)=" G IBQ:'VAXI"
|
---|
| 1961 | ^MAGD(2006.79,17,1,39,0)=" S VAX0=$S($D(^DGPM(VAXI,0)):^(0),1:"""")"
|
---|
| 1962 | ^MAGD(2006.79,17,1,40,0)=" G IBQ:VAX0']"""",IBQ:""^3^5^""[(""^""_$P(VAX0,""^"",2)_""^"")"
|
---|
| 1963 | ^MAGD(2006.79,17,1,41,0)=" S VAXI=$S($D(^DG(405.1,+$P(VAX0,""^"",4),0)):$P(^(0),""^""),1:"""")"
|
---|
| 1964 | ^MAGD(2006.79,17,1,42,0)=" ; -- check in-bed status flag"
|
---|
| 1965 | ^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)"
|
---|
| 1966 | ^MAGD(2006.79,17,1,44,0)="IBQ K VAXI,VAX0 Q"
|
---|
| 1967 | ^MAGD(2006.79,17,1,45,0)=" ;"
|
---|
| 1968 | ^MAGD(2006.79,17,1,46,0)="CHK ; -- check if mvt exists and if 'while asih' type d/c"
|
---|
| 1969 | ^MAGD(2006.79,17,1,47,0)=" ; if VAMV returned undefined then continue $Oing"
|
---|
| 1970 | ^MAGD(2006.79,17,1,48,0)=" ;"
|
---|
| 1971 | ^MAGD(2006.79,17,1,49,0)=" I $D(^DGPM(+VAMV,0)) S VAMV0=^(0),VAMT=$P(VAMV0,""^"",2)"
|
---|
| 1972 | ^MAGD(2006.79,17,1,50,0)=" I '$D(VAMV0) K VAMV G CHKQ"
|
---|
| 1973 | ^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"
|
---|
| 1974 | ^MAGD(2006.79,17,1,52,0)=" ; info: 47 mvt can not have seq #; will always be null"
|
---|
| 1975 | ^MAGD(2006.79,17,1,53,0)="CHKQ Q"
|
---|
| 1976 | ^MAGD(2006.79,17,1,54,0)=" ;"
|
---|
| 1977 | ^MAGD(2006.79,17,1,55,0)="ADM ; -- send back adm ifn for dfn on vaindt or now"
|
---|
| 1978 | ^MAGD(2006.79,17,1,56,0)=" S VADT=$S($D(VAINDT):VAINDT,1:"""") I 'VADT D NOW^%DTC S VADT=%"
|
---|
| 1979 | ^MAGD(2006.79,17,1,57,0)=" S VAID=9999999.999999-VADT,VADMVT="""""
|
---|
| 1980 | ^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)"
|
---|
| 1981 | ^MAGD(2006.79,17,1,59,0)=" .I VAMV0'>VADT,VAMV1>VADT S VADMVT=VAMV"
|
---|
| 1982 | ^MAGD(2006.79,17,1,60,0)=" K VAID,VADT,VAMV,VAMV0,VAMV1"
|
---|
| 1983 | ^MAGD(2006.79,18,0)="VADPT3^3060410.105553"
|
---|
| 1984 | ^MAGD(2006.79,18,1,0)="^2006.791^97^97"
|
---|
| 1985 | ^MAGD(2006.79,18,1,1,0)="VADPT3 ;ALB/MRL - PATIENT VARIABLES [IN5]; 12 DEC 1988 ; 7/22/03 5:00pm"
|
---|
| 1986 | ^MAGD(2006.79,18,1,2,0)=" ;;5.3;Registration;**532**;Aug 13, 1993"
|
---|
| 1987 | ^MAGD(2006.79,18,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
|
---|
| 1988 | ^MAGD(2006.79,18,1,4,0)="6 ;"
|
---|
| 1989 | ^MAGD(2006.79,18,1,5,0)=" D NOW^%DTC S (NOW,VAX(""DAT""))=%,NOWI=9999999.999999-%"
|
---|
| 1990 | ^MAGD(2006.79,18,1,6,0)=" ;"
|
---|
| 1991 | ^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"
|
---|
| 1992 | ^MAGD(2006.79,18,1,8,0)=" ;"
|
---|
| 1993 | ^MAGD(2006.79,18,1,9,0)=" I $D(VAIP(""D"")),""^l^L^""[(""^""_$E(VAIP(""D""))_""^"") D LAST G GO:E,Q"
|
---|
| 1994 | ^MAGD(2006.79,18,1,10,0)=" ;"
|
---|
| 1995 | ^MAGD(2006.79,18,1,11,0)=" S VAX=$S($D(VAIP(""D"")):VAIP(""D""),$D(VAINDT):VAINDT,1:0)"
|
---|
| 1996 | ^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"
|
---|
| 1997 | ^MAGD(2006.79,18,1,13,0)=" ;"
|
---|
| 1998 | ^MAGD(2006.79,18,1,14,0)=" S:'$D(VAX(""DT"")) VAX(""DT"")=NOW"
|
---|
| 1999 | ^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"
|
---|
| 2000 | ^MAGD(2006.79,18,1,16,0)=" ;"
|
---|
| 2001 | ^MAGD(2006.79,18,1,17,0)=" ;Find Past Movement"
|
---|
| 2002 | ^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"
|
---|
| 2003 | ^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"
|
---|
| 2004 | ^MAGD(2006.79,18,1,20,0)=" S VAZ=^DGPM(VAX,0) D OK G GO:E D LODGER G GO:E,Q"
|
---|
| 2005 | ^MAGD(2006.79,18,1,21,0)=" ;"
|
---|
| 2006 | ^MAGD(2006.79,18,1,22,0)="GO S:'$D(VAX(""DT"")) VAX(""DT"")=NOW D ^VADPT31 ; setting of VAX(""DT"") can be removed??"
|
---|
| 2007 | ^MAGD(2006.79,18,1,23,0)=" ;"
|
---|
| 2008 | ^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"
|
---|
| 2009 | ^MAGD(2006.79,18,1,25,0)=" ;"
|
---|
| 2010 | ^MAGD(2006.79,18,1,26,0)="OK N VAADT,VADDT,VAQUIT"
|
---|
| 2011 | ^MAGD(2006.79,18,1,27,0)=" S E=0,VAZ2=""^""_(+$P(VAZ,""^"",18))_""^"""
|
---|
| 2012 | ^MAGD(2006.79,18,1,28,0)=" I ""^13^41^46^""[VAZ2 D OK1 Q:'VAX G OK"
|
---|
| 2013 | ^MAGD(2006.79,18,1,29,0)=" I ""^42^""[VAZ2 D 42 I 'Y D OK1 Q:'VAX G OK"
|
---|
| 2014 | ^MAGD(2006.79,18,1,30,0)=" I ""^47^""[VAZ2 D 47 I 'Y D OK1 Q:'VAX G OK"
|
---|
| 2015 | ^MAGD(2006.79,18,1,31,0)=" I $D(VAX(""DT"")),$P(VAZ,""^"",2)=3,VAZ'>VAX(""DT"") Q"
|
---|
| 2016 | ^MAGD(2006.79,18,1,32,0)=" ;DG*5.3*532"
|
---|
| 2017 | ^MAGD(2006.79,18,1,33,0)=" ;Check for out-of-order disch. recs caused by same day adm./disch."
|
---|
| 2018 | ^MAGD(2006.79,18,1,34,0)=" ;where disch. date < adm. date because disch. date had no time"
|
---|
| 2019 | ^MAGD(2006.79,18,1,35,0)=" I +VAZ<2890000,$D(VAX(""DT"")),$P(VAZ,""^"",2)'=3 S VAQUIT=0 D Q:VAQUIT"
|
---|
| 2020 | ^MAGD(2006.79,18,1,36,0)=" .S VAADT=$P(VAZ,""^"",14) Q:'VAADT"
|
---|
| 2021 | ^MAGD(2006.79,18,1,37,0)=" .S VADDT=$P($G(^DGPM(VAADT,0)),""^"",17) Q:'VADDT"
|
---|
| 2022 | ^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"
|
---|
| 2023 | ^MAGD(2006.79,18,1,39,0)=" S E=+VAX Q"
|
---|
| 2024 | ^MAGD(2006.79,18,1,40,0)=" ;"
|
---|
| 2025 | ^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))"
|
---|
| 2026 | ^MAGD(2006.79,18,1,42,0)=" I VAX,$D(^DGPM(VAX,0)) S VAZ=^(0)"
|
---|
| 2027 | ^MAGD(2006.79,18,1,43,0)=" Q"
|
---|
| 2028 | ^MAGD(2006.79,18,1,44,0)=" ;"
|
---|
| 2029 | ^MAGD(2006.79,18,1,45,0)="LAST ; returns last movement for patient"
|
---|
| 2030 | ^MAGD(2006.79,18,1,46,0)=" ; called by bed control and pt inquiry"
|
---|
| 2031 | ^MAGD(2006.79,18,1,47,0)=" S VAX=+$O(^DGPM(""APID"",DFN,NOWI)),E=0"
|
---|
| 2032 | ^MAGD(2006.79,18,1,48,0)=" I $D(VAIP(""L"")) D LLDCHK G LASTQ:E"
|
---|
| 2033 | ^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"
|
---|
| 2034 | ^MAGD(2006.79,18,1,50,0)="LASTQ S VAX(""DT"")=NOW"
|
---|
| 2035 | ^MAGD(2006.79,18,1,51,0)=" Q"
|
---|
| 2036 | ^MAGD(2006.79,18,1,52,0)=" ;"
|
---|
| 2037 | ^MAGD(2006.79,18,1,53,0)="LODGER ;"
|
---|
| 2038 | ^MAGD(2006.79,18,1,54,0)=" S E=0 G LODGERQ:'$D(VAIP(""L""))"
|
---|
| 2039 | ^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"
|
---|
| 2040 | ^MAGD(2006.79,18,1,56,0)=" ;"
|
---|
| 2041 | ^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))"
|
---|
| 2042 | ^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"
|
---|
| 2043 | ^MAGD(2006.79,18,1,59,0)="LODGERQ Q"
|
---|
| 2044 | ^MAGD(2006.79,18,1,60,0)=" ;"
|
---|
| 2045 | ^MAGD(2006.79,18,1,61,0)="LLDCHK ; -- last lodger mvt checking ; build array of inverse dates and chk"
|
---|
| 2046 | ^MAGD(2006.79,18,1,62,0)=" N IDT S IDT(VAX)=0"
|
---|
| 2047 | ^MAGD(2006.79,18,1,63,0)=" S IDT=+$O(^DGPM(""ATID4"",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0))"
|
---|
| 2048 | ^MAGD(2006.79,18,1,64,0)=" S IDT=+$O(^DGPM(""ATID5"",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0))"
|
---|
| 2049 | ^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)"
|
---|
| 2050 | ^MAGD(2006.79,18,1,66,0)=" Q"
|
---|
| 2051 | ^MAGD(2006.79,18,1,67,0)=" ; "
|
---|
| 2052 | ^MAGD(2006.79,18,1,68,0)="CHK ;"
|
---|
| 2053 | ^MAGD(2006.79,18,1,69,0)=" G VAR^VADPT30"
|
---|
| 2054 | ^MAGD(2006.79,18,1,70,0)=" ;"
|
---|
| 2055 | ^MAGD(2006.79,18,1,71,0)="ASIHOF ; -- is last mvt asih oth fac"
|
---|
| 2056 | ^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)))"
|
---|
| 2057 | ^MAGD(2006.79,18,1,73,0)=" I VAX,$D(^DGPM(VAX,0)),""^43^45^""[(""^""_$P(^(0),""^"",18)_""^"") S E=VAX"
|
---|
| 2058 | ^MAGD(2006.79,18,1,74,0)=" Q"
|
---|
| 2059 | ^MAGD(2006.79,18,1,75,0)=" ;"
|
---|
| 2060 | ^MAGD(2006.79,18,1,76,0)="42 ; -- check to see if this mvt can be used; for 'while asih' d/c category"
|
---|
| 2061 | ^MAGD(2006.79,18,1,77,0)=" ; If Y returned high then mvt is good"
|
---|
| 2062 | ^MAGD(2006.79,18,1,78,0)=" ;"
|
---|
| 2063 | ^MAGD(2006.79,18,1,79,0)=" I VAZ'<VAX(""DAT"") S Y=0 G Q42 ; not a real d/c yet"
|
---|
| 2064 | ^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)"
|
---|
| 2065 | ^MAGD(2006.79,18,1,81,0)=" D SCAN"
|
---|
| 2066 | ^MAGD(2006.79,18,1,82,0)="Q42 Q"
|
---|
| 2067 | ^MAGD(2006.79,18,1,83,0)=" ;"
|
---|
| 2068 | ^MAGD(2006.79,18,1,84,0)="SCAN ; -- determine is d/c while in other fac(Y=1 returned if so.)"
|
---|
| 2069 | ^MAGD(2006.79,18,1,85,0)=" ;"
|
---|
| 2070 | ^MAGD(2006.79,18,1,86,0)=" N VAID,VACA,M S Y=0,VAID=9999999.999999-VAZ,VACA=+$P(VAZ,""^"",14)"
|
---|
| 2071 | ^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"
|
---|
| 2072 | ^MAGD(2006.79,18,1,88,0)=" Q"
|
---|
| 2073 | ^MAGD(2006.79,18,1,89,0)=" ;"
|
---|
| 2074 | ^MAGD(2006.79,18,1,90,0)="47 ; -- check to see if d/c from nhcu while asih in other fac"
|
---|
| 2075 | ^MAGD(2006.79,18,1,91,0)=" ; If y returned high then mvt is good."
|
---|
| 2076 | ^MAGD(2006.79,18,1,92,0)=" D SCAN Q"
|
---|
| 2077 | ^MAGD(2006.79,18,1,93,0)=" ;"
|
---|
| 2078 | ^MAGD(2006.79,18,1,94,0)=" ; 13 = to asih (vah) (xfr)|44 = resume asih in parent facility (xfr)"
|
---|
| 2079 | ^MAGD(2006.79,18,1,95,0)=" ; 41 = from asih (d/c)|45 = change asih location(other fac)(xfr)"
|
---|
| 2080 | ^MAGD(2006.79,18,1,96,0)=" ; 42 = while asih (d/c)|46 = continues asih (other fac) (d/c)"
|
---|
| 2081 | ^MAGD(2006.79,18,1,97,0)=" ; 43 = to asih(other fac)(xfr)|47 = discharge from nhcu while asih (d/c)"
|
---|
| 2082 | ^MAGD(2006.79,19,0)="VADPT30^3060410.105553"
|
---|
| 2083 | ^MAGD(2006.79,19,1,0)="^2006.791^81^81"
|
---|
| 2084 | ^MAGD(2006.79,19,1,1,0)="VADPT30 ;ALB/MJK - Current Inpatient Variables; 12 DEC 1988 ; 5/5/05 11:41am"
|
---|
| 2085 | ^MAGD(2006.79,19,1,2,0)=" ;;5.3;Registration;**111,498,509,662**;Aug 13, 1993"
|
---|
| 2086 | ^MAGD(2006.79,19,1,3,0)=" ;"
|
---|
| 2087 | ^MAGD(2006.79,19,1,4,0)="VAR ; -- inpatient demographics variables"
|
---|
| 2088 | ^MAGD(2006.79,19,1,5,0)=" ; input: DFN, VATD = inverse date ; VACN ="
|
---|
| 2089 | ^MAGD(2006.79,19,1,6,0)=" ; VAPRC = ; VAPRT ="
|
---|
| 2090 | ^MAGD(2006.79,19,1,7,0)=" ;"
|
---|
| 2091 | ^MAGD(2006.79,19,1,8,0)=" ; output: VAWD = ward ; VATS = tr. spec. ; VARM = room/bed"
|
---|
| 2092 | ^MAGD(2006.79,19,1,9,0)=" ; VAPP = doc ; VADX = diagnosis ; VAMV = mv entry"
|
---|
| 2093 | ^MAGD(2006.79,19,1,10,0)=" ; VAAP = attending physician"
|
---|
| 2094 | ^MAGD(2006.79,19,1,11,0)=" ; VAFD = answer to facility directory question"
|
---|
| 2095 | ^MAGD(2006.79,19,1,12,0)=" ;"
|
---|
| 2096 | ^MAGD(2006.79,19,1,13,0)=" S (VAWDA,VAWD,VATS,VAMV,VARM,VAPP,VAAP,VADX,VAFD)="""",VAID=VATD"
|
---|
| 2097 | ^MAGD(2006.79,19,1,14,0)=" ; -- get mv"
|
---|
| 2098 | ^MAGD(2006.79,19,1,15,0)=" D MV G VARQ:VAMV0']"""""
|
---|
| 2099 | ^MAGD(2006.79,19,1,16,0)=" S Y=$G(^DGPM(+$P(VAMV0,""^"",14),0)) I $P(Y,""^"",2)=1 D"
|
---|
| 2100 | ^MAGD(2006.79,19,1,17,0)=" .N DCD"
|
---|
| 2101 | ^MAGD(2006.79,19,1,18,0)=" .S DCD=+$P(Y,""^"",17) I DCD S DCD=+$G(^DGPM(DCD,0))"
|
---|
| 2102 | ^MAGD(2006.79,19,1,19,0)=" .S Y=$G(^DGPM(+$P(VAMV0,""^"",14),""DIR""))"
|
---|
| 2103 | ^MAGD(2006.79,19,1,20,0)=" .S Y=$P(Y,""^"",1)"
|
---|
| 2104 | ^MAGD(2006.79,19,1,21,0)=" .I Y="""" S Y=$S('DCD:1,(DCD<3030414.999999):"""",1:1) Q:Y="""""
|
---|
| 2105 | ^MAGD(2006.79,19,1,22,0)=" .S VAFD=Y_""^""_$$EXTERNAL^DILFD(405,41,,Y)"
|
---|
| 2106 | ^MAGD(2006.79,19,1,23,0)=" ; quit if not an adm or xfr"
|
---|
| 2107 | ^MAGD(2006.79,19,1,24,0)=" I ""^1^2^""'[(""^""_$P(VAMV0,""^"",2)_""^"") G VARQ"
|
---|
| 2108 | ^MAGD(2006.79,19,1,25,0)=" I 'VAPRC,""^2^3^13^25^26^43^44^45^""[(""^""_VAMT_""^"") G VARQ"
|
---|
| 2109 | ^MAGD(2006.79,19,1,26,0)=" I VAPRC,""^13^43^44^45^""[(""^""_VAMT_""^"") G VARQ"
|
---|
| 2110 | ^MAGD(2006.79,19,1,27,0)=" S:VAPRC VABO=$S(VAMT<4:VAMT,1:4) D GET"
|
---|
| 2111 | ^MAGD(2006.79,19,1,28,0)=" ;I 'VACN,'VATS S VATS=TSD ;what is this"
|
---|
| 2112 | ^MAGD(2006.79,19,1,29,0)="VARQ K VAMV0,VAMT,VAID"
|
---|
| 2113 | ^MAGD(2006.79,19,1,30,0)=" Q"
|
---|
| 2114 | ^MAGD(2006.79,19,1,31,0)=" ;"
|
---|
| 2115 | ^MAGD(2006.79,19,1,32,0)="GET ; -- get variables and quit when all set(Y=1)"
|
---|
| 2116 | ^MAGD(2006.79,19,1,33,0)=" S VACA=+$P(VAMV0,""^"",14)"
|
---|
| 2117 | ^MAGD(2006.79,19,1,34,0)=" N VAT"
|
---|
| 2118 | ^MAGD(2006.79,19,1,35,0)=" D TS,SET G GETQ:Y"
|
---|
| 2119 | ^MAGD(2006.79,19,1,36,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"
|
---|
| 2120 | ^MAGD(2006.79,19,1,37,0)="GETQ K VACA,VAIFN,VAID Q"
|
---|
| 2121 | ^MAGD(2006.79,19,1,38,0)=" ;"
|
---|
| 2122 | ^MAGD(2006.79,19,1,39,0)="KVAR K VAMV,VAWDA,VAWD,VARM,VAPP,VAAP,VATS,VATD,VAPRC,VAPRT,VACN,VADX,VABO,VAFD Q"
|
---|
| 2123 | ^MAGD(2006.79,19,1,40,0)=" ;"
|
---|
| 2124 | ^MAGD(2006.79,19,1,41,0)="SET ; -- set variables if null"
|
---|
| 2125 | ^MAGD(2006.79,19,1,42,0)=" S Y=0"
|
---|
| 2126 | ^MAGD(2006.79,19,1,43,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),""^"")"
|
---|
| 2127 | ^MAGD(2006.79,19,1,44,0)=" I 'VACN,VAWD S Y=1"
|
---|
| 2128 | ^MAGD(2006.79,19,1,45,0)=" N VARSTR"
|
---|
| 2129 | ^MAGD(2006.79,19,1,46,0)=" S VARSTR=""^^^^^VAWD^VARM^VAPP^VATS^VADX^^^^^^^^^VAAP^"""
|
---|
| 2130 | ^MAGD(2006.79,19,1,47,0)=" S $P(VARSTR,""^"",41)=""VAFD"""
|
---|
| 2131 | ^MAGD(2006.79,19,1,48,0)=" I VACN,'VAPRT,$D(DGPMDDF),@$P(VARSTR,""^"",+DGPMDDF),VAMV S Y=1"
|
---|
| 2132 | ^MAGD(2006.79,19,1,49,0)=" I VACN,VAPRT,VAWD,VAMV,VADX]"""" S Y=1"
|
---|
| 2133 | ^MAGD(2006.79,19,1,50,0)=" Q"
|
---|
| 2134 | ^MAGD(2006.79,19,1,51,0)=" ;"
|
---|
| 2135 | ^MAGD(2006.79,19,1,52,0)="TS ; set VADX, VATS, VAAP, and VAPP via VACA x-refs"
|
---|
| 2136 | ^MAGD(2006.79,19,1,53,0)=" N VAMV0"
|
---|
| 2137 | ^MAGD(2006.79,19,1,54,0)=" S:$D(^DGPM(VACA,0)) VADX=$P(^(0),""^"",10)"
|
---|
| 2138 | ^MAGD(2006.79,19,1,55,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"
|
---|
| 2139 | ^MAGD(2006.79,19,1,56,0)="TSQ K VAIFN,VAT Q"
|
---|
| 2140 | ^MAGD(2006.79,19,1,57,0)=" ;"
|
---|
| 2141 | ^MAGD(2006.79,19,1,58,0)="TS1 ; set VATS, VAPP, and VAAP"
|
---|
| 2142 | ^MAGD(2006.79,19,1,59,0)=" Q:'$D(^DGPM(VAIFN,0)) S VAMV0=^(0)"
|
---|
| 2143 | ^MAGD(2006.79,19,1,60,0)=" I 'VAPP,$D(^VA(200,+$P(VAMV0,""^"",8),0)) S Y=$P(VAMV0,""^"",8)_""^""_$P(^(0),""^"") S VAPP=Y"
|
---|
| 2144 | ^MAGD(2006.79,19,1,61,0)=" I 'VAAP,$D(^VA(200,+$P(VAMV0,""^"",19),0)) S Y=$P(VAMV0,""^"",19)_""^""_$P(^(0),""^"") S VAAP=Y"
|
---|
| 2145 | ^MAGD(2006.79,19,1,62,0)=" I 'VATS,$D(^DIC(45.7,+$P(VAMV0,""^"",9),0)) S VATS=$P(VAMV0,""^"",9)_""^""_$P(^(0),""^"")"
|
---|
| 2146 | ^MAGD(2006.79,19,1,63,0)=" Q"
|
---|
| 2147 | ^MAGD(2006.79,19,1,64,0)=" ;"
|
---|
| 2148 | ^MAGD(2006.79,19,1,65,0)="MV ; -- get latest mv for pt before VAID and not ASIH mv"
|
---|
| 2149 | ^MAGD(2006.79,19,1,66,0)=" S (VAMV,VAMV0)="""""
|
---|
| 2150 | ^MAGD(2006.79,19,1,67,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_""^"")"
|
---|
| 2151 | ^MAGD(2006.79,19,1,68,0)=" S VAMV0=^DGPM(VAMV,0)"
|
---|
| 2152 | ^MAGD(2006.79,19,1,69,0)="MVQ Q"
|
---|
| 2153 | ^MAGD(2006.79,19,1,70,0)=" ;"
|
---|
| 2154 | ^MAGD(2006.79,19,1,71,0)="A ;return current admission or last admission for patient"
|
---|
| 2155 | ^MAGD(2006.79,19,1,72,0)=" S Y=$S($D(^DPT(DFN,.105)):+^(.105),1:0) G AQ:$D(^DGPM(Y,0))"
|
---|
| 2156 | ^MAGD(2006.79,19,1,73,0)=" N VAID,VAMV,VAMV0"
|
---|
| 2157 | ^MAGD(2006.79,19,1,74,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"
|
---|
| 2158 | ^MAGD(2006.79,19,1,75,0)=" S Y=0"
|
---|
| 2159 | ^MAGD(2006.79,19,1,76,0)="AQ Q"
|
---|
| 2160 | ^MAGD(2006.79,19,1,77,0)=" ;"
|
---|
| 2161 | ^MAGD(2006.79,19,1,78,0)="DIS ; check for ASIH discharges"
|
---|
| 2162 | ^MAGD(2006.79,19,1,79,0)=" S Y=$S('$D(^DGPM(+$P(VAMV0,""^"",17),0)):VAMV,""^41^46""[(U_$P(^(0),""^"",18)_U):0,1:VAMV)"
|
---|
| 2163 | ^MAGD(2006.79,19,1,80,0)=" Q"
|
---|
| 2164 | ^MAGD(2006.79,19,1,81,0)=" ;"
|
---|
| 2165 | ^MAGD(2006.79,20,0)="VADPT31^3060410.105553"
|
---|
| 2166 | ^MAGD(2006.79,20,1,0)="^2006.791^76^76"
|
---|
| 2167 | ^MAGD(2006.79,20,1,1,0)="VADPT31 ;ALB/MRL/MJK - PATIENT VARIABLES [IN5], CONT.; 12 DEC 1988"
|
---|
| 2168 | ^MAGD(2006.79,20,1,2,0)=" ;;5.3;Registration;**498,509**;Aug 13, 1993"
|
---|
| 2169 | ^MAGD(2006.79,20,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
|
---|
| 2170 | ^MAGD(2006.79,20,1,4,0)="EN N VAINDT,VAMV,VAMV0"
|
---|
| 2171 | ^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))"
|
---|
| 2172 | ^MAGD(2006.79,20,1,6,0)=" I $D(VAIP(""M"")) D CE G ENQ:'$D(^DGPM(+E,0)) S VAMV=+E,VAMV0=^(0)"
|
---|
| 2173 | ^MAGD(2006.79,20,1,7,0)=" S @VAV@($P(VAS,""^"",1))=E"
|
---|
| 2174 | ^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:"""")"
|
---|
| 2175 | ^MAGD(2006.79,20,1,9,0)=" S Y=$S(+VAMV0:+VAMV0,1:"""") X:Y ^DD(""DD"") S @VAV@($P(VAS,""^"",3))=+VAMV0_""^""_Y"
|
---|
| 2176 | ^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:"""")"
|
---|
| 2177 | ^MAGD(2006.79,20,1,11,0)=" S Y=+$P(^DGPM(VAX(""CA""),0),""^"",16) S:Y @VAV@($P(VAS,""^"",12))=Y"
|
---|
| 2178 | ^MAGD(2006.79,20,1,12,0)=" ;"
|
---|
| 2179 | ^MAGD(2006.79,20,1,13,0)=" S VATD=VAX(""DT"") D FIND"
|
---|
| 2180 | ^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"
|
---|
| 2181 | ^MAGD(2006.79,20,1,15,0)=" ;"
|
---|
| 2182 | ^MAGD(2006.79,20,1,16,0)=" S VANODE=$G(^DGPM(VAX(""CA""),0)) I $P(VANODE,""^"",2)=1 D"
|
---|
| 2183 | ^MAGD(2006.79,20,1,17,0)=" .N DCD"
|
---|
| 2184 | ^MAGD(2006.79,20,1,18,0)=" .S DCD=+$P(VANODE,""^"",17) I DCD S DCD=+$G(^DGPM(DCD,0))"
|
---|
| 2185 | ^MAGD(2006.79,20,1,19,0)=" .S VANODE=$G(^DGPM(VAX(""CA""),""DIR""))"
|
---|
| 2186 | ^MAGD(2006.79,20,1,20,0)=" .S Y=$P(VANODE,""^"",1)"
|
---|
| 2187 | ^MAGD(2006.79,20,1,21,0)=" .I Y="""" S Y=$S('DCD:1,(DCD<3030414.999999):"""",1:1) Q:Y="""""
|
---|
| 2188 | ^MAGD(2006.79,20,1,22,0)=" .S @VAV@($P(VAS,""^"",19),1)=Y_""^""_$$EXTERNAL^DILFD(405,41,,Y)"
|
---|
| 2189 | ^MAGD(2006.79,20,1,23,0)=" .S Y=$P(VANODE,""^"",2) S @VAV@($P(VAS,""^"",19),2)=Y_""^""_$$EXTERNAL^DILFD(405,42,,Y)"
|
---|
| 2190 | ^MAGD(2006.79,20,1,24,0)=" .S Y=$P(VANODE,""^"",3) S @VAV@($P(VAS,""^"",19),3)=Y_""^""_$$EXTERNAL^DILFD(405,43,,Y)"
|
---|
| 2191 | ^MAGD(2006.79,20,1,25,0)=" ;"
|
---|
| 2192 | ^MAGD(2006.79,20,1,26,0)=" S VAINDT=+VAMV0 D IB^VADPT2 S @VAV@($P(VAS,""^"",10))=+VAZ"
|
---|
| 2193 | ^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"
|
---|
| 2194 | ^MAGD(2006.79,20,1,28,0)=" ;"
|
---|
| 2195 | ^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"
|
---|
| 2196 | ^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"
|
---|
| 2197 | ^MAGD(2006.79,20,1,31,0)=" I ""^3^5^""[(""^""_$P(VAMV0,""^"",2)_""^"") S VASET(17)="""",VANODE=$P(VAS,""^"",17) D COPY ; d/c"
|
---|
| 2198 | ^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"
|
---|
| 2199 | ^MAGD(2006.79,20,1,33,0)=" D BLD^VADPT32 G ENQ:'$D(^UTILITY(""VADPTZ"",$J,DFN))"
|
---|
| 2200 | ^MAGD(2006.79,20,1,34,0)=" S VAXE=$S($D(^UTILITY(""VADPTZ"",$J,DFN,1)):^(1),1:""""),VAMV0=$P(VAXE,""||"",2),VAMV=+VAXE"
|
---|
| 2201 | ^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"
|
---|
| 2202 | ^MAGD(2006.79,20,1,36,0)=" I VAMV,'$D(VASET(14)) S VANODE=$P(VAS,""^"",14) D STORE ;last"
|
---|
| 2203 | ^MAGD(2006.79,20,1,37,0)=" I $S('VANN:1,'$D(^UTILITY(""VADPTZ"",$J,DFN,+VANN)):1,1:0) G ENQ"
|
---|
| 2204 | ^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"
|
---|
| 2205 | ^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"
|
---|
| 2206 | ^MAGD(2006.79,20,1,40,0)=" ;"
|
---|
| 2207 | ^MAGD(2006.79,20,1,41,0)="ENQ K VAMVX,VANODE,VAMCC,VAXE,VANN D KVAR^VADPT30 Q"
|
---|
| 2208 | ^MAGD(2006.79,20,1,42,0)=" ;"
|
---|
| 2209 | ^MAGD(2006.79,20,1,43,0)="FIND ;"
|
---|
| 2210 | ^MAGD(2006.79,20,1,44,0)=" S VAMVX=VAMV,VAMV0X=VAMV0"
|
---|
| 2211 | ^MAGD(2006.79,20,1,45,0)=" S (VAWD,VATS,VAMV,VARM,VAPP,VAAP,VADX)="""""
|
---|
| 2212 | ^MAGD(2006.79,20,1,46,0)=" I $P(VAMV0,""^"",2)=4!($P(VAMV0,""^"",2)=5) D LODGER G FINDQ"
|
---|
| 2213 | ^MAGD(2006.79,20,1,47,0)=" S VATD=9999999.999999-VATD,(VACN,VAPRC,VAPRT)=1 D GET^VADPT30"
|
---|
| 2214 | ^MAGD(2006.79,20,1,48,0)="FINDQ S VAMV=VAMVX,VAMV0=VAMV0X K VAMVX,VAMV0X"
|
---|
| 2215 | ^MAGD(2006.79,20,1,49,0)=" Q"
|
---|
| 2216 | ^MAGD(2006.79,20,1,50,0)=" ;"
|
---|
| 2217 | ^MAGD(2006.79,20,1,51,0)="CE I 'VAIP(""M"") S E=+VAX(""CA"") Q"
|
---|
| 2218 | ^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"
|
---|
| 2219 | ^MAGD(2006.79,20,1,53,0)=" ;"
|
---|
| 2220 | ^MAGD(2006.79,20,1,54,0)="STORE ; store 'other nodes'"
|
---|
| 2221 | ^MAGD(2006.79,20,1,55,0)=" S @VAV@(VANODE)=+VAMV"
|
---|
| 2222 | ^MAGD(2006.79,20,1,56,0)=" S Y=+VAMV0 X:Y ^DD(""DD"") S @VAV@(VANODE,1)=+VAMV0_""^""_Y"
|
---|
| 2223 | ^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:"""")"
|
---|
| 2224 | ^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:"""")"
|
---|
| 2225 | ^MAGD(2006.79,20,1,59,0)=" S VATD=+VAMV0 D FIND"
|
---|
| 2226 | ^MAGD(2006.79,20,1,60,0)=" S @VAV@(VANODE,4)=VAWD,@VAV@(VANODE,5)=VAPP,@VAV@(VANODE,6)=VATS,@VAV@(VANODE,7)=VADX"
|
---|
| 2227 | ^MAGD(2006.79,20,1,61,0)=" Q"
|
---|
| 2228 | ^MAGD(2006.79,20,1,62,0)=" ;"
|
---|
| 2229 | ^MAGD(2006.79,20,1,63,0)="COPY ; copy from primary to other nodes"
|
---|
| 2230 | ^MAGD(2006.79,20,1,64,0)=" S @VAV@(VANODE)=VAMV"
|
---|
| 2231 | ^MAGD(2006.79,20,1,65,0)=" ; 1-mvt d/t ; 2-transaction type ; 3-mvt type"
|
---|
| 2232 | ^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))"
|
---|
| 2233 | ^MAGD(2006.79,20,1,67,0)=" ; 4-ward ; 5-doc ; 6-treat spec ; 7-dx"
|
---|
| 2234 | ^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))"
|
---|
| 2235 | ^MAGD(2006.79,20,1,69,0)=" Q"
|
---|
| 2236 | ^MAGD(2006.79,20,1,70,0)=" ;"
|
---|
| 2237 | ^MAGD(2006.79,20,1,71,0)="LODGER ; -- get lodger data"
|
---|
| 2238 | ^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:"""")"
|
---|
| 2239 | ^MAGD(2006.79,20,1,73,0)=" S VAWD=$S($D(^DIC(42,+VAWD,0)):VAWD_""^""_$P(^(0),""^""),1:"""")"
|
---|
| 2240 | ^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:"""")"
|
---|
| 2241 | ^MAGD(2006.79,20,1,75,0)=" S VARM=$S($D(^DG(405.4,+VARM,0)):VARM_""^""_$P(^(0),""^""),1:"""")"
|
---|
| 2242 | ^MAGD(2006.79,20,1,76,0)=" Q"
|
---|
| 2243 | ^MAGD(2006.79,21,0)="VADPT32^3060410.105553"
|
---|
| 2244 | ^MAGD(2006.79,21,1,0)="^2006.791^19^19"
|
---|
| 2245 | ^MAGD(2006.79,21,1,1,0)="VADPT32 ;ALB/MRL/MJK - PATIENT VARIABLES [IN5], CONT.; 12 DEC 1988"
|
---|
| 2246 | ^MAGD(2006.79,21,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
|
---|
| 2247 | ^MAGD(2006.79,21,1,3,0)=" ;Inpatient variables [Version 5.0 and above]"
|
---|
| 2248 | ^MAGD(2006.79,21,1,4,0)=" ;"
|
---|
| 2249 | ^MAGD(2006.79,21,1,5,0)="BLD ; build array of mvt in reverse order up one before E mvt"
|
---|
| 2250 | ^MAGD(2006.79,21,1,6,0)=" K ^UTILITY(""VADPTZ"",$J,DFN) S (VANN,VAQ,VAZ,VACC)=0"
|
---|
| 2251 | ^MAGD(2006.79,21,1,7,0)=" I ""^4^5^""[(""^""_$P(VAMV0,""^"",2)_""^"") D LODGER G BLDQ"
|
---|
| 2252 | ^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"
|
---|
| 2253 | ^MAGD(2006.79,21,1,9,0)="BLDQ K VACC,VAQ,VAZ Q"
|
---|
| 2254 | ^MAGD(2006.79,21,1,10,0)=" ;"
|
---|
| 2255 | ^MAGD(2006.79,21,1,11,0)="BA ;Build Movement Array"
|
---|
| 2256 | ^MAGD(2006.79,21,1,12,0)=" I VANN,VACC=(VANN+2) S VAQ=1 Q"
|
---|
| 2257 | ^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"
|
---|
| 2258 | ^MAGD(2006.79,21,1,14,0)=" ;"
|
---|
| 2259 | ^MAGD(2006.79,21,1,15,0)="LODGER ;"
|
---|
| 2260 | ^MAGD(2006.79,21,1,16,0)=" S VANN=1,X=^DGPM(E,0)"
|
---|
| 2261 | ^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)"
|
---|
| 2262 | ^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"
|
---|
| 2263 | ^MAGD(2006.79,21,1,19,0)=" Q"
|
---|
| 2264 | ^MAGD(2006.79,22,0)="VADPT4^3060410.105553"
|
---|
| 2265 | ^MAGD(2006.79,22,1,0)="^2006.791^58^58"
|
---|
| 2266 | ^MAGD(2006.79,22,1,1,0)="VADPT4 ;ALB/MRL/MJK - PATIENT VARIABLES; 12 DEC 1988"
|
---|
| 2267 | ^MAGD(2006.79,22,1,2,0)=" ;;5.3;Registration;**343,342,528**;Aug 13, 1993"
|
---|
| 2268 | ^MAGD(2006.79,22,1,3,0)="7 ;Eligibility [ELIG]"
|
---|
| 2269 | ^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:"""")"
|
---|
| 2270 | ^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"
|
---|
| 2271 | ^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"
|
---|
| 2272 | ^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"
|
---|
| 2273 | ^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"
|
---|
| 2274 | ^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"
|
---|
| 2275 | ^MAGD(2006.79,22,1,10,0)=" I VAZ F I=1:1:6 S @VAV@($P(VAS,""^"",5),I)="""" G 71"
|
---|
| 2276 | ^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"
|
---|
| 2277 | ^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"
|
---|
| 2278 | ^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)"
|
---|
| 2279 | ^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"
|
---|
| 2280 | ^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"
|
---|
| 2281 | ^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)"
|
---|
| 2282 | ^MAGD(2006.79,22,1,17,0)=" Q"
|
---|
| 2283 | ^MAGD(2006.79,22,1,18,0)=" ;"
|
---|
| 2284 | ^MAGD(2006.79,22,1,19,0)="8 ;Monetary Benefits [MB]"
|
---|
| 2285 | ^MAGD(2006.79,22,1,20,0)=" N DGTOTVA"
|
---|
| 2286 | ^MAGD(2006.79,22,1,21,0)=" S @VAV@($P(VAS,""^"",6))=0 ; SSI no longer supported"
|
---|
| 2287 | ^MAGD(2006.79,22,1,22,0)=" D ALL^DGMTU21(DFN,""V"",DT,""I"")"
|
---|
| 2288 | ^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)"
|
---|
| 2289 | ^MAGD(2006.79,22,1,24,0)=" S VAX=$G(^DPT(DFN,.362))"
|
---|
| 2290 | ^MAGD(2006.79,22,1,25,0)=" S DGTOTVA=$P(VAX,U,20)"
|
---|
| 2291 | ^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)"
|
---|
| 2292 | ^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)"
|
---|
| 2293 | ^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)"
|
---|
| 2294 | ^MAGD(2006.79,22,1,29,0)=" K DGDEP,DGREL,DGINC,DGINR Q"
|
---|
| 2295 | ^MAGD(2006.79,22,1,30,0)=" ;"
|
---|
| 2296 | ^MAGD(2006.79,22,1,31,0)="9 ;Service information"
|
---|
| 2297 | ^MAGD(2006.79,22,1,32,0)=" F I=.32,.321,.52,.53 S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"""")"
|
---|
| 2298 | ^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"
|
---|
| 2299 | ^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"
|
---|
| 2300 | ^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"
|
---|
| 2301 | ^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))="""""
|
---|
| 2302 | ^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"
|
---|
| 2303 | ^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"
|
---|
| 2304 | ^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"
|
---|
| 2305 | ^MAGD(2006.79,22,1,40,0)=" Q"
|
---|
| 2306 | ^MAGD(2006.79,22,1,41,0)=" ;"
|
---|
| 2307 | ^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:"""")"
|
---|
| 2308 | ^MAGD(2006.79,22,1,43,0)=" Q:VAX(3)=1!(VAX(3)=9)!(VAX(3)=10)"
|
---|
| 2309 | ^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"
|
---|
| 2310 | ^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"
|
---|
| 2311 | ^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"
|
---|
| 2312 | ^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"
|
---|
| 2313 | ^MAGD(2006.79,22,1,48,0)=" Q"
|
---|
| 2314 | ^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"
|
---|
| 2315 | ^MAGD(2006.79,22,1,50,0)=" Q"
|
---|
| 2316 | ^MAGD(2006.79,22,1,51,0)="93 ;"
|
---|
| 2317 | ^MAGD(2006.79,22,1,52,0)=" NEW VAFILE,VAIENS,VAFLDS,VAARR,VAI"
|
---|
| 2318 | ^MAGD(2006.79,22,1,53,0)=" S VAFILE=2,VAIENS=DFN_"","",VAFLDS="".532;.533"""
|
---|
| 2319 | ^MAGD(2006.79,22,1,54,0)=" D GETS^DIQ(VAFILE,VAIENS,VAFLDS,""IEN"",""VAARR"")"
|
---|
| 2320 | ^MAGD(2006.79,22,1,55,0)=" F VAI=1:1 S VAFLDS(VAI)=$P(VAFLDS,"";"",VAI) Q:VAFLDS(VAI)="""" D"
|
---|
| 2321 | ^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)="""""
|
---|
| 2322 | ^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""))"
|
---|
| 2323 | ^MAGD(2006.79,22,1,58,0)=" Q"
|
---|
| 2324 | ^MAGD(2006.79,23,0)="VADPT5^3060410.105553"
|
---|
| 2325 | ^MAGD(2006.79,23,1,0)="^2006.791^103^103"
|
---|
| 2326 | ^MAGD(2006.79,23,1,1,0)="VADPT5 ;ALB/MRL/MJK - PATIENT VARIABLES [REG]; 14 DEC 1988 ; 8/6/04 7:42am"
|
---|
| 2327 | ^MAGD(2006.79,23,1,2,0)=" ;;5.3;Registration;**54,63,242,584**;Aug 13, 1993"
|
---|
| 2328 | ^MAGD(2006.79,23,1,3,0)="10 ;Registration/Disposition [REG]"
|
---|
| 2329 | ^MAGD(2006.79,23,1,4,0)=" N VARPSV"
|
---|
| 2330 | ^MAGD(2006.79,23,1,5,0)=" S VARPSV(""C"")=$S('$G(VARP(""C"")):999999999,1:+VARP(""C""))"
|
---|
| 2331 | ^MAGD(2006.79,23,1,6,0)=" S VARPSV(""F"")=9999999-$S($G(VARP(""F""))?7N.E:VARP(""F""),1:0)"
|
---|
| 2332 | ^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"
|
---|
| 2333 | ^MAGD(2006.79,23,1,8,0)=" S VARPSV(""T"")=9999999-VARPSV(""T"")"
|
---|
| 2334 | ^MAGD(2006.79,23,1,9,0)=" S VAX=VARPSV(""T""),VAX(1)=0"
|
---|
| 2335 | ^MAGD(2006.79,23,1,10,0)=" I '$D(^DPT(DFN,""DIS"")) Q"
|
---|
| 2336 | ^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"
|
---|
| 2337 | ^MAGD(2006.79,23,1,12,0)=" Q"
|
---|
| 2338 | ^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"
|
---|
| 2339 | ^MAGD(2006.79,23,1,14,0)=" S @VAV@(VAX(1),""I"")=VAX(""I""),@VAV@(VAX(1),""E"")=VAX(""E"") Q"
|
---|
| 2340 | ^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"
|
---|
| 2341 | ^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"
|
---|
| 2342 | ^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)"
|
---|
| 2343 | ^MAGD(2006.79,23,1,18,0)=" Q"
|
---|
| 2344 | ^MAGD(2006.79,23,1,19,0)=" ;"
|
---|
| 2345 | ^MAGD(2006.79,23,1,20,0)="11 ;Clinic Enrollments [SDE]"
|
---|
| 2346 | ^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"
|
---|
| 2347 | ^MAGD(2006.79,23,1,22,0)=" Q"
|
---|
| 2348 | ^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)"
|
---|
| 2349 | ^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"
|
---|
| 2350 | ^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:"""")"
|
---|
| 2351 | ^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"
|
---|
| 2352 | ^MAGD(2006.79,23,1,27,0)=" ;"
|
---|
| 2353 | ^MAGD(2006.79,23,1,28,0)="12 ;Appointments [SDA]"
|
---|
| 2354 | ^MAGD(2006.79,23,1,29,0)=" N VASDSV,SDCNT,SDARRAY"
|
---|
| 2355 | ^MAGD(2006.79,23,1,30,0)=" D NOW^%DTC"
|
---|
| 2356 | ^MAGD(2006.79,23,1,31,0)=" S VASDSV(""F"")=$S($G(VASD(""F""))?7N.E:VASD(""F""),1:%)"
|
---|
| 2357 | ^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"
|
---|
| 2358 | ^MAGD(2006.79,23,1,33,0)=" S VASDSV(""W"")=$S('$G(VASD(""W"")):12,1:VASD(""W""))"
|
---|
| 2359 | ^MAGD(2006.79,23,1,34,0)=" S VAZ(2)=$S($D(VASD(""N"")):VASD(""N""),1:9999)"
|
---|
| 2360 | ^MAGD(2006.79,23,1,35,0)=" ;Set STATUS Codes (VistA;RSA)"
|
---|
| 2361 | ^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)="""""
|
---|
| 2362 | ^MAGD(2006.79,23,1,37,0)=" ;Extract User Required STATUS Codes in RSA format"
|
---|
| 2363 | ^MAGD(2006.79,23,1,38,0)=" F I=1:1 S I1=+$E(VASDSV(""W""),I) Q:'I1 D"
|
---|
| 2364 | ^MAGD(2006.79,23,1,39,0)=" .S VAZ(1)=VAZ(1)_$P($P(VAZ,""^"",I1),"";"",2)_"";"""
|
---|
| 2365 | ^MAGD(2006.79,23,1,40,0)=" ;Create parameter list for the extrinsic call to the Appointment API"
|
---|
| 2366 | ^MAGD(2006.79,23,1,41,0)=" ;Note: Appointment API can only accept a maximum of 3 fields "
|
---|
| 2367 | ^MAGD(2006.79,23,1,42,0)=" ; to filter on."
|
---|
| 2368 | ^MAGD(2006.79,23,1,43,0)=" ; 1 : ""FROM;TO"" Appointment Date Range to Search"
|
---|
| 2369 | ^MAGD(2006.79,23,1,44,0)=" ; 2 : Clinic IEN or Array of Clinic IENs if defined (Pass the Root)"
|
---|
| 2370 | ^MAGD(2006.79,23,1,45,0)=" ; 3 : Requested STATUS Codes (Passed if VASD(""C"") is not defined.)"
|
---|
| 2371 | ^MAGD(2006.79,23,1,46,0)=" ; 4 : Patient IEN"
|
---|
| 2372 | ^MAGD(2006.79,23,1,47,0)=" S SDARRAY="""",SDARRAY(1)=VASDSV(""F"")_"";""_VASDSV(""T"")"
|
---|
| 2373 | ^MAGD(2006.79,23,1,48,0)=" I $O(VASD(""C"",0))>0 S SDARRAY(2)=""VASD(""""C"""","""
|
---|
| 2374 | ^MAGD(2006.79,23,1,49,0)=" E S SDARRAY(3)=VAZ(1)"
|
---|
| 2375 | ^MAGD(2006.79,23,1,50,0)=" S SDARRAY(4)=DFN"
|
---|
| 2376 | ^MAGD(2006.79,23,1,51,0)=" ;Set Fields for API to Return"
|
---|
| 2377 | ^MAGD(2006.79,23,1,52,0)=" ; 1 : Appointment Date/Time"
|
---|
| 2378 | ^MAGD(2006.79,23,1,53,0)=" ; 2 : Clinic"
|
---|
| 2379 | ^MAGD(2006.79,23,1,54,0)=" ; 3 : Appointment Status"
|
---|
| 2380 | ^MAGD(2006.79,23,1,55,0)=" ; 10 : Appointment Type"
|
---|
| 2381 | ^MAGD(2006.79,23,1,56,0)=" S SDARRAY(""FLDS"")=""1;2;3;10"""
|
---|
| 2382 | ^MAGD(2006.79,23,1,57,0)=" ;Remove Clinic IEN from Global Reference"
|
---|
| 2383 | ^MAGD(2006.79,23,1,58,0)=" S SDARRAY(""SORT"")=""P"""
|
---|
| 2384 | ^MAGD(2006.79,23,1,59,0)=" ;Call Appointment API (Pass Array by reference)"
|
---|
| 2385 | ^MAGD(2006.79,23,1,60,0)=" S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)"
|
---|
| 2386 | ^MAGD(2006.79,23,1,61,0)=" S VAX="""",VAX(1)=0"
|
---|
| 2387 | ^MAGD(2006.79,23,1,62,0)=" ;If error returned, determine error and set VAERR appropriately"
|
---|
| 2388 | ^MAGD(2006.79,23,1,63,0)=" ; 1 : For any error other than 101"
|
---|
| 2389 | ^MAGD(2006.79,23,1,64,0)=" ; 2 : If error is 101 : Database is unavailable "
|
---|
| 2390 | ^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"
|
---|
| 2391 | ^MAGD(2006.79,23,1,66,0)=" D 122:SDCNT>0"
|
---|
| 2392 | ^MAGD(2006.79,23,1,67,0)=" Q"
|
---|
| 2393 | ^MAGD(2006.79,23,1,68,0)="121 S VAX(5)=1 I VASDSV(""W"")'[1,$P(VAZ,""^"",2)']"""" S VAX(5)=0 Q"
|
---|
| 2394 | ^MAGD(2006.79,23,1,69,0)=" I VASDSV(""C""),'$D(VASD(""C"",+VAZ)) S VAX(5)=0 Q"
|
---|
| 2395 | ^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)"
|
---|
| 2396 | ^MAGD(2006.79,23,1,71,0)=" Q"
|
---|
| 2397 | ^MAGD(2006.79,23,1,72,0)="122 ;Build Internal/External Output Globals"
|
---|
| 2398 | ^MAGD(2006.79,23,1,73,0)=" ;"
|
---|
| 2399 | ^MAGD(2006.79,23,1,74,0)=" N SDCIEN,SDDTM,SDNODE"
|
---|
| 2400 | ^MAGD(2006.79,23,1,75,0)=" S (SDCIEN,SDDTM)="""""
|
---|
| 2401 | ^MAGD(2006.79,23,1,76,0)=" ;Redefine VAZ (STATUS Codes(RSA;VistA))"
|
---|
| 2402 | ^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^"""
|
---|
| 2403 | ^MAGD(2006.79,23,1,78,0)=" S SDDTM="""""
|
---|
| 2404 | ^MAGD(2006.79,23,1,79,0)=" ;Loop through appointments and convert for output"
|
---|
| 2405 | ^MAGD(2006.79,23,1,80,0)=" F S SDDTM=$O(^TMP($J,""SDAMA301"",DFN,SDDTM)) Q:'SDDTM D "
|
---|
| 2406 | ^MAGD(2006.79,23,1,81,0)=" .;Get Appointment Information and clear VAX(""I"") & VAX(""E"")"
|
---|
| 2407 | ^MAGD(2006.79,23,1,82,0)=" .S SDNODE=^(SDDTM),(VAX(""I""),VAX(""E""))="""""
|
---|
| 2408 | ^MAGD(2006.79,23,1,83,0)=" .;If Clinics were passed to appointment API,"
|
---|
| 2409 | ^MAGD(2006.79,23,1,84,0)=" .; Filter on Appointment Status Codes"
|
---|
| 2410 | ^MAGD(2006.79,23,1,85,0)=" .I $O(VASD(""C"",0))>0,(VAZ(1)'[($P($P(SDNODE,""^"",3),"";"")_"";"")) Q"
|
---|
| 2411 | ^MAGD(2006.79,23,1,86,0)=" .;Extract and format Appointment Date/Time"
|
---|
| 2412 | ^MAGD(2006.79,23,1,87,0)=" .S Y=$P(SDNODE,""^"",1)"
|
---|
| 2413 | ^MAGD(2006.79,23,1,88,0)=" .S $P(VAX(""I""),""^"",1)=Y"
|
---|
| 2414 | ^MAGD(2006.79,23,1,89,0)=" .X ^DD(""DD"") S $P(VAX(""E""),""^"",1)=Y"
|
---|
| 2415 | ^MAGD(2006.79,23,1,90,0)=" .;Extract and format Clinic Information"
|
---|
| 2416 | ^MAGD(2006.79,23,1,91,0)=" .S $P(VAX(""I""),""^"",2)=$P($P(SDNODE,""^"",2),"";"",1)"
|
---|
| 2417 | ^MAGD(2006.79,23,1,92,0)=" .S $P(VAX(""E""),""^"",2)=$P($P(SDNODE,""^"",2),"";"",2)"
|
---|
| 2418 | ^MAGD(2006.79,23,1,93,0)=" .;Extract and format Appointment Type"
|
---|
| 2419 | ^MAGD(2006.79,23,1,94,0)=" .S $P(VAX(""I""),""^"",4)=$P($P(SDNODE,""^"",10),"";"",1)"
|
---|
| 2420 | ^MAGD(2006.79,23,1,95,0)=" .S $P(VAX(""E""),""^"",4)=$P($P(SDNODE,""^"",10),"";"",2)"
|
---|
| 2421 | ^MAGD(2006.79,23,1,96,0)=" .;Extract and format Appointment Status"
|
---|
| 2422 | ^MAGD(2006.79,23,1,97,0)=" .S Y=$P($P(VAZ,$P($P(SDNODE,""^"",3),"";"")_"";"",2),""^""),$P(VAX(""I""),""^"",3)=Y"
|
---|
| 2423 | ^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)"
|
---|
| 2424 | ^MAGD(2006.79,23,1,99,0)=" .S VAX(1)=VAX(1)+1"
|
---|
| 2425 | ^MAGD(2006.79,23,1,100,0)=" .;Store information in global"
|
---|
| 2426 | ^MAGD(2006.79,23,1,101,0)=" .S @VAV@(VAX(1),""I"")=VAX(""I""),@VAV@(VAX(1),""E"")=VAX(""E"")"
|
---|
| 2427 | ^MAGD(2006.79,23,1,102,0)=" K ^TMP($J,""SDAMA301"")"
|
---|
| 2428 | ^MAGD(2006.79,23,1,103,0)=" Q"
|
---|
| 2429 | ^MAGD(2006.79,24,0)="VADPT6^3060410.105553"
|
---|
| 2430 | ^MAGD(2006.79,24,1,0)="^2006.791^73^73"
|
---|
| 2431 | ^MAGD(2006.79,24,1,1,0)="VADPT6 ;ALB/MJK - PATIENT ID VARIABLES ; 12 AUG 89 @1200"
|
---|
| 2432 | ^MAGD(2006.79,24,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
|
---|
| 2433 | ^MAGD(2006.79,24,1,3,0)=" ;"
|
---|
| 2434 | ^MAGD(2006.79,24,1,4,0)="PID ;"
|
---|
| 2435 | ^MAGD(2006.79,24,1,5,0)="13 ; -- Returns the patient id variables for DFN patient"
|
---|
| 2436 | ^MAGD(2006.79,24,1,6,0)=" ; usually VA(""PID"")=123-45-6789 and VA(""BID"")=""6789"""
|
---|
| 2437 | ^MAGD(2006.79,24,1,7,0)=" ; for VA patients."
|
---|
| 2438 | ^MAGD(2006.79,24,1,8,0)=" ;"
|
---|
| 2439 | ^MAGD(2006.79,24,1,9,0)=" ; -- Returns patient id variables as defined for the requested"
|
---|
| 2440 | ^MAGD(2006.79,24,1,10,0)=" ; patient eligibility for DFN patient. The variable VAPTYP should"
|
---|
| 2441 | ^MAGD(2006.79,24,1,11,0)=" ; contain the internal number of the desired patient eligibility."
|
---|
| 2442 | ^MAGD(2006.79,24,1,12,0)=" ;"
|
---|
| 2443 | ^MAGD(2006.79,24,1,13,0)=" ; If the VAPTYP eligibility does not exist, then the standard"
|
---|
| 2444 | ^MAGD(2006.79,24,1,14,0)=" ; values, as defined above, will be passed back."
|
---|
| 2445 | ^MAGD(2006.79,24,1,15,0)=" ;"
|
---|
| 2446 | ^MAGD(2006.79,24,1,16,0)=" N X,L,B K VAERR S (L,B)="""""
|
---|
| 2447 | ^MAGD(2006.79,24,1,17,0)=" ; L = long id ; B = brief or short id"
|
---|
| 2448 | ^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"
|
---|
| 2449 | ^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)"
|
---|
| 2450 | ^MAGD(2006.79,24,1,20,0)=" ; -- set default id's"
|
---|
| 2451 | ^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)"
|
---|
| 2452 | ^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)"
|
---|
| 2453 | ^MAGD(2006.79,24,1,23,0)=" ;"
|
---|
| 2454 | ^MAGD(2006.79,24,1,24,0)="PIDQ S VA(""PID"")=L,VA(""BID"")=B Q"
|
---|
| 2455 | ^MAGD(2006.79,24,1,25,0)=" ;"
|
---|
| 2456 | ^MAGD(2006.79,24,1,26,0)="SET ;-- execute id format specific long id, short id and x-ref set logic"
|
---|
| 2457 | ^MAGD(2006.79,24,1,27,0)=" ; input: VADFN == DFN"
|
---|
| 2458 | ^MAGD(2006.79,24,1,28,0)=" ;"
|
---|
| 2459 | ^MAGD(2006.79,24,1,29,0)=" Q:'$D(^DPT(VADFN,""E"",0))"
|
---|
| 2460 | ^MAGD(2006.79,24,1,30,0)=" N X,DA S DA(1)=VADFN"
|
---|
| 2461 | ^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"
|
---|
| 2462 | ^MAGD(2006.79,24,1,32,0)=" K X,DA"
|
---|
| 2463 | ^MAGD(2006.79,24,1,33,0)=" Q"
|
---|
| 2464 | ^MAGD(2006.79,24,1,34,0)="SET1 ;"
|
---|
| 2465 | ^MAGD(2006.79,24,1,35,0)=" D CHK G SET1Q:'VAFMT"
|
---|
| 2466 | ^MAGD(2006.79,24,1,36,0)=" ; -- calc/store long id"
|
---|
| 2467 | ^MAGD(2006.79,24,1,37,0)=" S X="""""
|
---|
| 2468 | ^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"
|
---|
| 2469 | ^MAGD(2006.79,24,1,39,0)=" ; -- long id x-refs (set logic)"
|
---|
| 2470 | ^MAGD(2006.79,24,1,40,0)=" S VAX=X G SET1Q:X="""""
|
---|
| 2471 | ^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"
|
---|
| 2472 | ^MAGD(2006.79,24,1,42,0)=" ; -- short id x-refs (set logic)"
|
---|
| 2473 | ^MAGD(2006.79,24,1,43,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,4) G SET1Q:X="""""
|
---|
| 2474 | ^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"
|
---|
| 2475 | ^MAGD(2006.79,24,1,45,0)="SET1Q K VAIX,VAX,X,VAFMT"
|
---|
| 2476 | ^MAGD(2006.79,24,1,46,0)=" Q"
|
---|
| 2477 | ^MAGD(2006.79,24,1,47,0)=" ;"
|
---|
| 2478 | ^MAGD(2006.79,24,1,48,0)="KILL ; -- execute id format specific x-ref kill logic"
|
---|
| 2479 | ^MAGD(2006.79,24,1,49,0)=" ; input: VADFN ==> DFN"
|
---|
| 2480 | ^MAGD(2006.79,24,1,50,0)=" ;"
|
---|
| 2481 | ^MAGD(2006.79,24,1,51,0)=" Q:'$D(^DPT(VADFN,""E"",0))"
|
---|
| 2482 | ^MAGD(2006.79,24,1,52,0)=" N X,DA S DA(1)=VADFN"
|
---|
| 2483 | ^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"
|
---|
| 2484 | ^MAGD(2006.79,24,1,54,0)=" K X,DA"
|
---|
| 2485 | ^MAGD(2006.79,24,1,55,0)=" Q"
|
---|
| 2486 | ^MAGD(2006.79,24,1,56,0)=" ;"
|
---|
| 2487 | ^MAGD(2006.79,24,1,57,0)="KILL1 ;"
|
---|
| 2488 | ^MAGD(2006.79,24,1,58,0)=" D CHK G KILL1Q:'VAFMT"
|
---|
| 2489 | ^MAGD(2006.79,24,1,59,0)=" ; -- short id x-ref (kill logic)"
|
---|
| 2490 | ^MAGD(2006.79,24,1,60,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,4) G KILL2:X="""""
|
---|
| 2491 | ^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"
|
---|
| 2492 | ^MAGD(2006.79,24,1,62,0)=" S $P(^DPT(DA(1),""E"",DA,0),U,4)="""""
|
---|
| 2493 | ^MAGD(2006.79,24,1,63,0)="KILL2 ; -- long id (kill logic)"
|
---|
| 2494 | ^MAGD(2006.79,24,1,64,0)=" S (VAX,X)=$P(^DPT(DA(1),""E"",DA,0),U,3) G KILL1Q:X="""""
|
---|
| 2495 | ^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"
|
---|
| 2496 | ^MAGD(2006.79,24,1,66,0)=" S $P(^DPT(DA(1),""E"",DA,0),U,3)="""""
|
---|
| 2497 | ^MAGD(2006.79,24,1,67,0)="KILL1Q K VAX,VAIX,VAFMT"
|
---|
| 2498 | ^MAGD(2006.79,24,1,68,0)=" Q"
|
---|
| 2499 | ^MAGD(2006.79,24,1,69,0)=" ;"
|
---|
| 2500 | ^MAGD(2006.79,24,1,70,0)="CHK ; -- ok to proceed ; fmt defined"
|
---|
| 2501 | ^MAGD(2006.79,24,1,71,0)=" S VAFMT=0"
|
---|
| 2502 | ^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)"
|
---|
| 2503 | ^MAGD(2006.79,24,1,73,0)=" Q"
|
---|
| 2504 | ^MAGD(2006.79,25,0)="VADPT60^3060410.105553"
|
---|
| 2505 | ^MAGD(2006.79,25,1,0)="^2006.791^100^100"
|
---|
| 2506 | ^MAGD(2006.79,25,1,1,0)="VADPT60 ;ALB/MJK - Patient ID Utilities; 12 AUG 89 @1200"
|
---|
| 2507 | ^MAGD(2006.79,25,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
|
---|
| 2508 | ^MAGD(2006.79,25,1,3,0)=" ;"
|
---|
| 2509 | ^MAGD(2006.79,25,1,4,0)="EN D DT^DICRW S X=""VADPT60"",DIK=""^DOPT(""""""_X_"""""","""
|
---|
| 2510 | ^MAGD(2006.79,25,1,5,0)=" G:$D(^DOPT(X,7)) A S ^DOPT(X,0)=""Patient ID Utilities^1N^"""
|
---|
| 2511 | ^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)"
|
---|
| 2512 | ^MAGD(2006.79,25,1,7,0)=" D IXALL^DIK"
|
---|
| 2513 | ^MAGD(2006.79,25,1,8,0)="A ;"
|
---|
| 2514 | ^MAGD(2006.79,25,1,9,0)=" W !! S DIC=""^DOPT(""""VADPT60"""","",DIC(0)=""IQEAM"" D ^DIC Q:Y<0 D @+Y G A"
|
---|
| 2515 | ^MAGD(2006.79,25,1,10,0)=" ;"
|
---|
| 2516 | ^MAGD(2006.79,25,1,11,0)="1 ;;ID Format Enter/Edit"
|
---|
| 2517 | ^MAGD(2006.79,25,1,12,0)=" G 1^VADPT61"
|
---|
| 2518 | ^MAGD(2006.79,25,1,13,0)=" ;"
|
---|
| 2519 | ^MAGD(2006.79,25,1,14,0)="2 ;;Eligibility Code Enter/Edit"
|
---|
| 2520 | ^MAGD(2006.79,25,1,15,0)=" G 2^VADPT61"
|
---|
| 2521 | ^MAGD(2006.79,25,1,16,0)=" ;"
|
---|
| 2522 | ^MAGD(2006.79,25,1,17,0)="3 ;;Specific ID Format Reset (All Patients)"
|
---|
| 2523 | ^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"
|
---|
| 2524 | ^MAGD(2006.79,25,1,19,0)=" S X=Y(0) D WARN^VADPT61"
|
---|
| 2525 | ^MAGD(2006.79,25,1,20,0)="31 W !!,""Are you sure"" S %=2 D YN^DICN"
|
---|
| 2526 | ^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"
|
---|
| 2527 | ^MAGD(2006.79,25,1,22,0)=" G 3:%'=1"
|
---|
| 2528 | ^MAGD(2006.79,25,1,23,0)=" S VAOPT=3 D TASK^VADPT61 G Q3"
|
---|
| 2529 | ^MAGD(2006.79,25,1,24,0)="QUE3 ; -- determine which elig use format"
|
---|
| 2530 | ^MAGD(2006.79,25,1,25,0)=" D BEG^VADPT61"
|
---|
| 2531 | ^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)="""""
|
---|
| 2532 | ^MAGD(2006.79,25,1,27,0)=" ; -- find pt's and reset"
|
---|
| 2533 | ^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"
|
---|
| 2534 | ^MAGD(2006.79,25,1,29,0)=" D END^VADPT61"
|
---|
| 2535 | ^MAGD(2006.79,25,1,30,0)="Q3 K DFN,VAELG,VAFMT Q"
|
---|
| 2536 | ^MAGD(2006.79,25,1,31,0)=" ;"
|
---|
| 2537 | ^MAGD(2006.79,25,1,32,0)="4 ;;Primary Eligibility ID Reset (All Patients)"
|
---|
| 2538 | ^MAGD(2006.79,25,1,33,0)=" W !!,""Are you sure"" S %=2 D YN^DICN"
|
---|
| 2539 | ^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"
|
---|
| 2540 | ^MAGD(2006.79,25,1,35,0)=" G Q4:%'=1"
|
---|
| 2541 | ^MAGD(2006.79,25,1,36,0)="41 S VAOPT=4 D TASK^VADPT61 G Q4"
|
---|
| 2542 | ^MAGD(2006.79,25,1,37,0)="QUE4 K VALL D BEG^VADPT61,ALL,END^VADPT61"
|
---|
| 2543 | ^MAGD(2006.79,25,1,38,0)="Q4 Q"
|
---|
| 2544 | ^MAGD(2006.79,25,1,39,0)=" ;"
|
---|
| 2545 | ^MAGD(2006.79,25,1,40,0)="5 ;;Specific Eligibility ID Reset (All Patients)"
|
---|
| 2546 | ^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"
|
---|
| 2547 | ^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"
|
---|
| 2548 | ^MAGD(2006.79,25,1,43,0)=" S X=^(0) D WARN^VADPT61"
|
---|
| 2549 | ^MAGD(2006.79,25,1,44,0)="51 W !!,""Are you sure"" S %=2 D YN^DICN"
|
---|
| 2550 | ^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"
|
---|
| 2551 | ^MAGD(2006.79,25,1,46,0)=" G 5:%'=1"
|
---|
| 2552 | ^MAGD(2006.79,25,1,47,0)=" S VAOPT=5 D TASK^VADPT61 G Q5"
|
---|
| 2553 | ^MAGD(2006.79,25,1,48,0)="QUE5 D BEG^VADPT61"
|
---|
| 2554 | ^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"
|
---|
| 2555 | ^MAGD(2006.79,25,1,50,0)=" D END^VADPT61"
|
---|
| 2556 | ^MAGD(2006.79,25,1,51,0)="Q5 K VAELG,DFN Q"
|
---|
| 2557 | ^MAGD(2006.79,25,1,52,0)=" ;"
|
---|
| 2558 | ^MAGD(2006.79,25,1,53,0)="6 ;;Reset ALL ID's for a Patient"
|
---|
| 2559 | ^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"
|
---|
| 2560 | ^MAGD(2006.79,25,1,55,0)="61 W !!,""Are you sure"" S %=2 D YN^DICN"
|
---|
| 2561 | ^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"
|
---|
| 2562 | ^MAGD(2006.79,25,1,57,0)=" G 6:%'=1"
|
---|
| 2563 | ^MAGD(2006.79,25,1,58,0)="PAT ; -- entry point if DFN is defined"
|
---|
| 2564 | ^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)"
|
---|
| 2565 | ^MAGD(2006.79,25,1,60,0)="Q6 K DFN,VAELG"
|
---|
| 2566 | ^MAGD(2006.79,25,1,61,0)=" Q"
|
---|
| 2567 | ^MAGD(2006.79,25,1,62,0)=" ;"
|
---|
| 2568 | ^MAGD(2006.79,25,1,63,0)="7 ;;Reset ALL ID's for ALL Patients"
|
---|
| 2569 | ^MAGD(2006.79,25,1,64,0)=" W !!,""Are you sure"" S %=2 D YN^DICN"
|
---|
| 2570 | ^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"
|
---|
| 2571 | ^MAGD(2006.79,25,1,66,0)=" G Q7:%'=1"
|
---|
| 2572 | ^MAGD(2006.79,25,1,67,0)=" S VAOPT=7 D TASK^VADPT61 G Q7"
|
---|
| 2573 | ^MAGD(2006.79,25,1,68,0)="QUE7 S VALL="""" D BEG^VADPT61,ALL,END^VADPT61"
|
---|
| 2574 | ^MAGD(2006.79,25,1,69,0)="Q7 K VALL"
|
---|
| 2575 | ^MAGD(2006.79,25,1,70,0)=" Q"
|
---|
| 2576 | ^MAGD(2006.79,25,1,71,0)=" ;"
|
---|
| 2577 | ^MAGD(2006.79,25,1,72,0)="FILE ;"
|
---|
| 2578 | ^MAGD(2006.79,25,1,73,0)=" S $P(^DPT(DFN,""E"",0),U,2)=""2.0361P"""
|
---|
| 2579 | ^MAGD(2006.79,25,1,74,0)=" I $D(^DPT(DFN,""E"",VAELG,0)) D IX G PATQ"
|
---|
| 2580 | ^MAGD(2006.79,25,1,75,0)=" L +^DPT(DFN,""E"",VAELG)"
|
---|
| 2581 | ^MAGD(2006.79,25,1,76,0)=" S $P(^(0),""^"",3,4)=VAELG_""^""_($P(^DPT(DFN,""E"",0),""^"",4)+1)"
|
---|
| 2582 | ^MAGD(2006.79,25,1,77,0)=" S ^DPT(DFN,""E"",VAELG,0)=VAELG"
|
---|
| 2583 | ^MAGD(2006.79,25,1,78,0)=" L -^DPT(DFN,""E"",VAELG)"
|
---|
| 2584 | ^MAGD(2006.79,25,1,79,0)=" S DA(1)=DFN,DA=VAELG,DIK=""^DPT(""_DA(1)_"",""""E"""","",DIK(1)="".01"" D EN1^DIK"
|
---|
| 2585 | ^MAGD(2006.79,25,1,80,0)=" K DA,DIK Q"
|
---|
| 2586 | ^MAGD(2006.79,25,1,81,0)="PATQ Q"
|
---|
| 2587 | ^MAGD(2006.79,25,1,82,0)=" ;"
|
---|
| 2588 | ^MAGD(2006.79,25,1,83,0)="IX ;"
|
---|
| 2589 | ^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"
|
---|
| 2590 | ^MAGD(2006.79,25,1,85,0)=" K DA,DIK Q"
|
---|
| 2591 | ^MAGD(2006.79,25,1,86,0)=" ;"
|
---|
| 2592 | ^MAGD(2006.79,25,1,87,0)="ALL ; -- resets all id's for all pt's"
|
---|
| 2593 | ^MAGD(2006.79,25,1,88,0)=" ; if VALL not defined then only primary reset"
|
---|
| 2594 | ^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"
|
---|
| 2595 | ^MAGD(2006.79,25,1,90,0)=" K VAPRI,DFN,VAELG"
|
---|
| 2596 | ^MAGD(2006.79,25,1,91,0)=" Q"
|
---|
| 2597 | ^MAGD(2006.79,25,1,92,0)=" ;"
|
---|
| 2598 | ^MAGD(2006.79,25,1,93,0)="PRI ; -- set/reset pri elig id"
|
---|
| 2599 | ^MAGD(2006.79,25,1,94,0)=" S VAPRI=0"
|
---|
| 2600 | ^MAGD(2006.79,25,1,95,0)=" I $D(^DPT(DFN,.36)) S (VAPRI,VAELG)=+^(.36) I $D(^DIC(8,VAELG,0)) D FILE"
|
---|
| 2601 | ^MAGD(2006.79,25,1,96,0)=" Q"
|
---|
| 2602 | ^MAGD(2006.79,25,1,97,0)=" ;"
|
---|
| 2603 | ^MAGD(2006.79,25,1,98,0)="UPDT ; -- called by v5 clean-up"
|
---|
| 2604 | ^MAGD(2006.79,25,1,99,0)=" W !,"">>>PRIMARY ELIGIBILITY ID UPDATE..."""
|
---|
| 2605 | ^MAGD(2006.79,25,1,100,0)=" D 41 Q"
|
---|
| 2606 | ^MAGD(2006.79,26,0)="VADPT61^3060410.105553"
|
---|
| 2607 | ^MAGD(2006.79,26,1,0)="^2006.791^60^60"
|
---|
| 2608 | ^MAGD(2006.79,26,1,1,0)="VADPT61 ;ALB/MJK - Patient ID Utilities (cont.); 12 AUG 89 @1200"
|
---|
| 2609 | ^MAGD(2006.79,26,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
|
---|
| 2610 | ^MAGD(2006.79,26,1,3,0)=" ;"
|
---|
| 2611 | ^MAGD(2006.79,26,1,4,0)="1 ;;ID Format Enter/Edit"
|
---|
| 2612 | ^MAGD(2006.79,26,1,5,0)=" W ! S DIC=""^DIC(8.2,"",DIC(0)=""AELMQ"" D ^DIC K DIC G Q1:+Y<1"
|
---|
| 2613 | ^MAGD(2006.79,26,1,6,0)=" S DA=+Y,DIE=""^DIC(8.2,"",DR=""[DG ID FORMAT ENTER/EDIT]"" D ^DIE G 1"
|
---|
| 2614 | ^MAGD(2006.79,26,1,7,0)="Q1 K DIE,DR,DA,Y Q"
|
---|
| 2615 | ^MAGD(2006.79,26,1,8,0)=" ;"
|
---|
| 2616 | ^MAGD(2006.79,26,1,9,0)="2 ;;Eligibility Code Enter/Edit"
|
---|
| 2617 | ^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"
|
---|
| 2618 | ^MAGD(2006.79,26,1,11,0)=" S DA=+Y,DIE=""^DIC(8,"",DR=""[DG ELIG ENTER/EDIT]"" D ^DIE G 2"
|
---|
| 2619 | ^MAGD(2006.79,26,1,12,0)="Q2 K DIE,DR,DA,Y"
|
---|
| 2620 | ^MAGD(2006.79,26,1,13,0)=" Q"
|
---|
| 2621 | ^MAGD(2006.79,26,1,14,0)=" ;"
|
---|
| 2622 | ^MAGD(2006.79,26,1,15,0)="ASK ;"
|
---|
| 2623 | ^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))"
|
---|
| 2624 | ^MAGD(2006.79,26,1,17,0)=" W !!,*7,""User Input Needed for '"",$P(^DIC(8,VAELG,0),U),""' id:"""
|
---|
| 2625 | ^MAGD(2006.79,26,1,18,0)=" S DIE=""^DPT(""_DFN_"",""""E"""","",DR=.03,DA(1)=DFN,DA=VAELG D ^DIE"
|
---|
| 2626 | ^MAGD(2006.79,26,1,19,0)=" W !!?5,""..."",$P(^DIC(8,VAELG,0),U)"
|
---|
| 2627 | ^MAGD(2006.79,26,1,20,0)=" K DIE,DR,DA,Y"
|
---|
| 2628 | ^MAGD(2006.79,26,1,21,0)=" Q"
|
---|
| 2629 | ^MAGD(2006.79,26,1,22,0)=" ;"
|
---|
| 2630 | ^MAGD(2006.79,26,1,23,0)="WARN ; -- interaction warning"
|
---|
| 2631 | ^MAGD(2006.79,26,1,24,0)=" I $P(X,U,2) W !!?5,*7,""WARNING: User interaction usually is required for this format."""
|
---|
| 2632 | ^MAGD(2006.79,26,1,25,0)=" Q"
|
---|
| 2633 | ^MAGD(2006.79,26,1,26,0)=" ;"
|
---|
| 2634 | ^MAGD(2006.79,26,1,27,0)="BEG ;"
|
---|
| 2635 | ^MAGD(2006.79,26,1,28,0)=" D NOW^%DTC S VASTART=%"
|
---|
| 2636 | ^MAGD(2006.79,26,1,29,0)=" Q"
|
---|
| 2637 | ^MAGD(2006.79,26,1,30,0)=" ;"
|
---|
| 2638 | ^MAGD(2006.79,26,1,31,0)="END ;"
|
---|
| 2639 | ^MAGD(2006.79,26,1,32,0)=" D NOW^%DTC S VAEND=%,L=0"
|
---|
| 2640 | ^MAGD(2006.79,26,1,33,0)=" K XMY"
|
---|
| 2641 | ^MAGD(2006.79,26,1,34,0)=" S XMSUB=$P($T(OPTS+VAOPT),"";"",4),XMDUZ=.5,XMTEXT=""VATEXT("",XMY(DUZ)="""""
|
---|
| 2642 | ^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"")_"")"""
|
---|
| 2643 | ^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"")_"")"""
|
---|
| 2644 | ^MAGD(2006.79,26,1,37,0)=" S L=L+1 S VATEXT(L,0)="" """
|
---|
| 2645 | ^MAGD(2006.79,26,1,38,0)=" S Y=VASTART,L=L+1 X ^DD(""DD"") S VATEXT(L,0)="" Job started at ""_Y"
|
---|
| 2646 | ^MAGD(2006.79,26,1,39,0)=" S Y=VAEND,L=L+1 X ^DD(""DD"") S VATEXT(L,0)="" Job completed at ""_Y"
|
---|
| 2647 | ^MAGD(2006.79,26,1,40,0)=" D ^XMD"
|
---|
| 2648 | ^MAGD(2006.79,26,1,41,0)=" K VAOPT,VASTART,VAEND,L,VATEXT,XMY,XMSUB,XMDUZ,XMTEXT,Y,% Q"
|
---|
| 2649 | ^MAGD(2006.79,26,1,42,0)=" ;"
|
---|
| 2650 | ^MAGD(2006.79,26,1,43,0)="TASK ;"
|
---|
| 2651 | ^MAGD(2006.79,26,1,44,0)=" W !!?5,""The resetting of ID formats can take many hours."""
|
---|
| 2652 | ^MAGD(2006.79,26,1,45,0)=" W !?5,""It is suggested that it be run at off-peak hours,"""
|
---|
| 2653 | ^MAGD(2006.79,26,1,46,0)=" W !?5,""perferably over a weekend."",!"
|
---|
| 2654 | ^MAGD(2006.79,26,1,47,0)=" K ZTSK S X=$T(OPTS+VAOPT),VARS=$P(X,"";"",5)"
|
---|
| 2655 | ^MAGD(2006.79,26,1,48,0)=" F I=1:1 S Y=$P(VARS,""^"",I) Q:Y="""" S ZTSAVE(Y)="""""
|
---|
| 2656 | ^MAGD(2006.79,26,1,49,0)=" S ZTSAVE(""VAOPT"")="""",ZTRTN=""QUE""_VAOPT_""^VADPT60"",ZTDESC=$P(X,"";"",4),ZTIO="""" D ^%ZTLOAD"
|
---|
| 2657 | ^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."""
|
---|
| 2658 | ^MAGD(2006.79,26,1,51,0)="TASKQ K ZTIO,ZTRTN,ZTDESC,ZTSAVE,VARS,Y,X,ZTSK Q"
|
---|
| 2659 | ^MAGD(2006.79,26,1,52,0)=" ;"
|
---|
| 2660 | ^MAGD(2006.79,26,1,53,0)="OPTS ; -- queue task list ;;opt#;description;vars to save"
|
---|
| 2661 | ^MAGD(2006.79,26,1,54,0)=" ;;1;none"
|
---|
| 2662 | ^MAGD(2006.79,26,1,55,0)=" ;;2;none"
|
---|
| 2663 | ^MAGD(2006.79,26,1,56,0)=" ;;3;Reset ID Format;VAFMT"
|
---|
| 2664 | ^MAGD(2006.79,26,1,57,0)=" ;;4;Reset Primary Eligibilty ID Format"
|
---|
| 2665 | ^MAGD(2006.79,26,1,58,0)=" ;;5;Reset Specific Eligibilty ID Format;VAELG"
|
---|
| 2666 | ^MAGD(2006.79,26,1,59,0)=" ;;6;none"
|
---|
| 2667 | ^MAGD(2006.79,26,1,60,0)=" ;;7;Reset All ID Formats for all Patients"
|
---|
| 2668 | ^MAGD(2006.79,27,0)="VADPT62^3060410.105553"
|
---|
| 2669 | ^MAGD(2006.79,27,1,0)="^2006.791^50^50"
|
---|
| 2670 | ^MAGD(2006.79,27,1,1,0)="VADPT62 ;ALB/MJK - Patient ID Trigger Nodes ; 11 MAR 1991"
|
---|
| 2671 | ^MAGD(2006.79,27,1,2,0)=" ;;5.3;Registration;;Aug 13, 1993"
|
---|
| 2672 | ^MAGD(2006.79,27,1,3,0)=" ;"
|
---|
| 2673 | ^MAGD(2006.79,27,1,4,0)=" ; This routine contains all the the 1 and 2 nodes for triggers"
|
---|
| 2674 | ^MAGD(2006.79,27,1,5,0)=" ; on fields in the PATIENT ELIGIBILITIES multiple of the"
|
---|
| 2675 | ^MAGD(2006.79,27,1,6,0)=" ; PATIENT file."
|
---|
| 2676 | ^MAGD(2006.79,27,1,7,0)=" ;"
|
---|
| 2677 | ^MAGD(2006.79,27,1,8,0)=" ; Because of the layered nature of the execution of these"
|
---|
| 2678 | ^MAGD(2006.79,27,1,9,0)=" ; triggers, M11+ could not handle their execution reliably."
|
---|
| 2679 | ^MAGD(2006.79,27,1,10,0)=" ; Store errors would sometimes occur."
|
---|
| 2680 | ^MAGD(2006.79,27,1,11,0)=" ;"
|
---|
| 2681 | ^MAGD(2006.79,27,1,12,0)=" ; By placing the code for these nodes in this rouitne, the operating"
|
---|
| 2682 | ^MAGD(2006.79,27,1,13,0)=" ; system will not have use up as much symbol space to store the"
|
---|
| 2683 | ^MAGD(2006.79,27,1,14,0)=" ; executeable code. The 1 and 2 nodes now only contain calls"
|
---|
| 2684 | ^MAGD(2006.79,27,1,15,0)=" ; to the appropriate tag in this routine. [Tag 'P31' is the"
|
---|
| 2685 | ^MAGD(2006.79,27,1,16,0)=" ; tag called by the 3rd cross reference of the LONG ID field"
|
---|
| 2686 | ^MAGD(2006.79,27,1,17,0)=" ; to execute the 'set' logic of the trigger - ^DD(2.0361,.03,1,3,1).]"
|
---|
| 2687 | ^MAGD(2006.79,27,1,18,0)=" ;"
|
---|
| 2688 | ^MAGD(2006.79,27,1,19,0)="E31 ; -- first set node of ^DD(2.0361,.01,1,3,1) trigger on ELIGIBILITY field"
|
---|
| 2689 | ^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)"
|
---|
| 2690 | ^MAGD(2006.79,27,1,21,0)=" Q"
|
---|
| 2691 | ^MAGD(2006.79,27,1,22,0)=" ;"
|
---|
| 2692 | ^MAGD(2006.79,27,1,23,0)="E32 ; -- first kill node of ^DD(2.0361,.01,1,3,2) trigger on ELIGIBILITY field"
|
---|
| 2693 | ^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)"
|
---|
| 2694 | ^MAGD(2006.79,27,1,25,0)=" Q"
|
---|
| 2695 | ^MAGD(2006.79,27,1,26,0)=" ;"
|
---|
| 2696 | ^MAGD(2006.79,27,1,27,0)="L11 ; -- first set node of ^DD(2.0361,.03,1,1,1) trigger on LONG ID field"
|
---|
| 2697 | ^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)"
|
---|
| 2698 | ^MAGD(2006.79,27,1,29,0)=" Q"
|
---|
| 2699 | ^MAGD(2006.79,27,1,30,0)=" ;"
|
---|
| 2700 | ^MAGD(2006.79,27,1,31,0)="L12 ; -- first kill node of ^DD(2.0361,.03,1,1,2) trigger on LONG ID field"
|
---|
| 2701 | ^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)"
|
---|
| 2702 | ^MAGD(2006.79,27,1,33,0)=" Q"
|
---|
| 2703 | ^MAGD(2006.79,27,1,34,0)=" ;"
|
---|
| 2704 | ^MAGD(2006.79,27,1,35,0)="L31 ; -- first set node of ^DD(2.0361,.03,1,3,1) trigger on LONG ID field"
|
---|
| 2705 | ^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)"
|
---|
| 2706 | ^MAGD(2006.79,27,1,37,0)=" Q"
|
---|
| 2707 | ^MAGD(2006.79,27,1,38,0)=" ;"
|
---|
| 2708 | ^MAGD(2006.79,27,1,39,0)="L32 ; -- first kill node of ^DD(2.0361,.03,1,3,2) trigger on LONG ID"
|
---|
| 2709 | ^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)"
|
---|
| 2710 | ^MAGD(2006.79,27,1,41,0)=" Q"
|
---|
| 2711 | ^MAGD(2006.79,27,1,42,0)=" ;"
|
---|
| 2712 | ^MAGD(2006.79,27,1,43,0)="S31 ; -- first set node of ^DD(2.0361,.04,1,3,1) trigger on SHORT ID field"
|
---|
| 2713 | ^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)"
|
---|
| 2714 | ^MAGD(2006.79,27,1,45,0)=" Q"
|
---|
| 2715 | ^MAGD(2006.79,27,1,46,0)=" ;"
|
---|
| 2716 | ^MAGD(2006.79,27,1,47,0)="S32 ; -- first kill node of ^DD(2.0361,.04,1,3,2) trigger on SHORT ID field"
|
---|
| 2717 | ^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)"
|
---|
| 2718 | ^MAGD(2006.79,27,1,49,0)=" Q"
|
---|
| 2719 | ^MAGD(2006.79,27,1,50,0)=" ;"
|
---|
| 2720 | ^MAGD(2006.79,28,0)="XLFDT^3060410.105553"
|
---|
| 2721 | ^MAGD(2006.79,28,1,0)="^2006.791^178^178"
|
---|
| 2722 | ^MAGD(2006.79,28,1,1,0)="XLFDT ;ISC-SF/STAFF - Date/Time Functions ;03/27/2003 14:09"
|
---|
| 2723 | ^MAGD(2006.79,28,1,2,0)=" ;;8.0;KERNEL;**71,120,166,168,179,280**;Jul 10, 1995"
|
---|
| 2724 | ^MAGD(2006.79,28,1,3,0)=" ;VA FileMan uses 2400 as midnight, many other system use 0000."
|
---|
| 2725 | ^MAGD(2006.79,28,1,4,0)=" ;This is true for $H and HL7, so a conversion has to adjust"
|
---|
| 2726 | ^MAGD(2006.79,28,1,5,0)=" ;the day when converting Midnight."
|
---|
| 2727 | ^MAGD(2006.79,28,1,6,0)=" ;i.e. 3001225.24 is the same as HL7 '200012260000' and $H '58434,0'"
|
---|
| 2728 | ^MAGD(2006.79,28,1,7,0)=" ;The range of accepted $H dates: ""2,0"" to ""99999,85399""."
|
---|
| 2729 | ^MAGD(2006.79,28,1,8,0)=" ;The range of accepted FM dates: 1410102 to 4141015 (any valid time)."
|
---|
| 2730 | ^MAGD(2006.79,28,1,9,0)=" ;The range of accepted HL7 dates: 18410102 to 21141015 (any valid time)."
|
---|
| 2731 | ^MAGD(2006.79,28,1,10,0)=" ;It is expected that input values are valid dates."
|
---|
| 2732 | ^MAGD(2006.79,28,1,11,0)=" ;"
|
---|
| 2733 | ^MAGD(2006.79,28,1,12,0)="HTFM(%H,%F) ;$H to FM, %F=1 for date only"
|
---|
| 2734 | ^MAGD(2006.79,28,1,13,0)=" N X,%,%T,%Y,%M,%D S:'$D(%F) %F=0"
|
---|
| 2735 | ^MAGD(2006.79,28,1,14,0)=" I $$HR(%H) Q -1 ;Check Range"
|
---|
| 2736 | ^MAGD(2006.79,28,1,15,0)=" I '%F,%H["",0"" S %H=(%H-1)_"",86400"""
|
---|
| 2737 | ^MAGD(2006.79,28,1,16,0)=" D YMD S:%T&('%F) X=X_%T"
|
---|
| 2738 | ^MAGD(2006.79,28,1,17,0)=" Q X"
|
---|
| 2739 | ^MAGD(2006.79,28,1,18,0)=" ;"
|
---|
| 2740 | ^MAGD(2006.79,28,1,19,0)="H2F(%H) ;Internal to this routine use"
|
---|
| 2741 | ^MAGD(2006.79,28,1,20,0)=" N X,%,%T,%Y,%M,%D"
|
---|
| 2742 | ^MAGD(2006.79,28,1,21,0)=" D YMD S:%T X=X_%T"
|
---|
| 2743 | ^MAGD(2006.79,28,1,22,0)=" Q X"
|
---|
| 2744 | ^MAGD(2006.79,28,1,23,0)=" ;"
|
---|
| 2745 | ^MAGD(2006.79,28,1,24,0)="YMD ;21608 = 28 feb 1900, 94657 = 28 feb 2100, 141 $H base year"
|
---|
| 2746 | ^MAGD(2006.79,28,1,25,0)=" S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1"
|
---|
| 2747 | ^MAGD(2006.79,28,1,26,0)=" S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1"
|
---|
| 2748 | ^MAGD(2006.79,28,1,27,0)=" S X=%Y_""00""+%M_""00""+%D,%=$P(%H,"","",2)"
|
---|
| 2749 | ^MAGD(2006.79,28,1,28,0)=" S %T=%#60/100+(%#3600\60)/100+(%\3600)/100 S:'%T %T="".0"""
|
---|
| 2750 | ^MAGD(2006.79,28,1,29,0)=" Q"
|
---|
| 2751 | ^MAGD(2006.79,28,1,30,0)=" ;"
|
---|
| 2752 | ^MAGD(2006.79,28,1,31,0)="FMTH(X,%F) ;FM to $H, %F=1 for date only"
|
---|
| 2753 | ^MAGD(2006.79,28,1,32,0)=" N %Y,%H,%A S:'$D(%F) %F=0"
|
---|
| 2754 | ^MAGD(2006.79,28,1,33,0)=" I $$FR(X) Q -1 ;$H range of 1 - 99999"
|
---|
| 2755 | ^MAGD(2006.79,28,1,34,0)=" I '%F,X["".24"" S %A=1"
|
---|
| 2756 | ^MAGD(2006.79,28,1,35,0)=" D H S:%F %H=+%H I $D(%A) S %H=(%H+1)_"",0"""
|
---|
| 2757 | ^MAGD(2006.79,28,1,36,0)=" Q %H"
|
---|
| 2758 | ^MAGD(2006.79,28,1,37,0)=" ;"
|
---|
| 2759 | ^MAGD(2006.79,28,1,38,0)="F2H(X) ;Internal to this routine use"
|
---|
| 2760 | ^MAGD(2006.79,28,1,39,0)=" N %Y,%H,%A"
|
---|
| 2761 | ^MAGD(2006.79,28,1,40,0)=" D H"
|
---|
| 2762 | ^MAGD(2006.79,28,1,41,0)=" Q %H"
|
---|
| 2763 | ^MAGD(2006.79,28,1,42,0)=" ;"
|
---|
| 2764 | ^MAGD(2006.79,28,1,43,0)="H ;Build %H from FM"
|
---|
| 2765 | ^MAGD(2006.79,28,1,44,0)=" N %,%L,%M,%D,%T I X<1410101 S %H=0,%Y=-1 Q"
|
---|
| 2766 | ^MAGD(2006.79,28,1,45,0)=" S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)"
|
---|
| 2767 | ^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)"
|
---|
| 2768 | ^MAGD(2006.79,28,1,47,0)=" ;%L = (# leap years) - (# leap years before base)"
|
---|
| 2769 | ^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"
|
---|
| 2770 | ^MAGD(2006.79,28,1,49,0)=" S %H=$P(""^31^59^90^120^151^181^212^243^273^304^334"",""^"",%M)+%D"
|
---|
| 2771 | ^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)"
|
---|
| 2772 | ^MAGD(2006.79,28,1,51,0)=" Q"
|
---|
| 2773 | ^MAGD(2006.79,28,1,52,0)=" ;"
|
---|
| 2774 | ^MAGD(2006.79,28,1,53,0)="HTE(%H,%F) ;$H to external"
|
---|
| 2775 | ^MAGD(2006.79,28,1,54,0)=" Q:$$HR(%H) %H ;Range Check"
|
---|
| 2776 | ^MAGD(2006.79,28,1,55,0)=" N Y,%T,%R"
|
---|
| 2777 | ^MAGD(2006.79,28,1,56,0)=" S %F=$G(%F,1) S Y=$$HTFM(%H,0) G T2"
|
---|
| 2778 | ^MAGD(2006.79,28,1,57,0)=" ;"
|
---|
| 2779 | ^MAGD(2006.79,28,1,58,0)="FMTE(Y,%F) ;FM to external"
|
---|
| 2780 | ^MAGD(2006.79,28,1,59,0)=" Q:(Y<1000000)!(Y>9991231) Y ;Range Check"
|
---|
| 2781 | ^MAGD(2006.79,28,1,60,0)=" N %T,%R S %F=$G(%F,1)"
|
---|
| 2782 | ^MAGD(2006.79,28,1,61,0)=" ;Both HTE and FMTE come here."
|
---|
| 2783 | ^MAGD(2006.79,28,1,62,0)="T2 S %T="".""_$E($P(Y,""."",2)_""000000"",1,7)"
|
---|
| 2784 | ^MAGD(2006.79,28,1,63,0)=" D FMT^XLFDT1 Q %R"
|
---|
| 2785 | ^MAGD(2006.79,28,1,64,0)=" ;"
|
---|
| 2786 | ^MAGD(2006.79,28,1,65,0)="FR(%V) ;Check FM in valid range"
|
---|
| 2787 | ^MAGD(2006.79,28,1,66,0)=" Q (%V<1410102)!(%V>4141015.235959)"
|
---|
| 2788 | ^MAGD(2006.79,28,1,67,0)="HR(%V) ;Check $H in valid range"
|
---|
| 2789 | ^MAGD(2006.79,28,1,68,0)=" Q (%V<2)!(%V>99999)"
|
---|
| 2790 | ^MAGD(2006.79,28,1,69,0)=" ;"
|
---|
| 2791 | ^MAGD(2006.79,28,1,70,0)="FMTHL7(%P1) ;Convert FM date/time to HL7 format"
|
---|
| 2792 | ^MAGD(2006.79,28,1,71,0)=" N %T Q:'$L(%P1) """" S %P1=+%P1 ;Make sure a cononic number"
|
---|
| 2793 | ^MAGD(2006.79,28,1,72,0)=" I $$FR(%P1) Q -1 ;Check range"
|
---|
| 2794 | ^MAGD(2006.79,28,1,73,0)=" S %T=$P(%P1,""."",2),%P1=$P(%P1,""."")"
|
---|
| 2795 | ^MAGD(2006.79,28,1,74,0)=" I %T=24 S %P1=$$FMADD($P(%P1,"".""),1),%T=""0000"""
|
---|
| 2796 | ^MAGD(2006.79,28,1,75,0)=" S:%P1>1 %P1=%P1+17000000"
|
---|
| 2797 | ^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))"
|
---|
| 2798 | ^MAGD(2006.79,28,1,77,0)=" I $L(%T) S %P1=%P1_%T_$$TZ()"
|
---|
| 2799 | ^MAGD(2006.79,28,1,78,0)=" Q %P1"
|
---|
| 2800 | ^MAGD(2006.79,28,1,79,0)=" ;"
|
---|
| 2801 | ^MAGD(2006.79,28,1,80,0)="HL7TFM(%P1,%P2,%P3) ;Convert HL7 D/T to FM."
|
---|
| 2802 | ^MAGD(2006.79,28,1,81,0)=" ;%P1 is the value to convert"
|
---|
| 2803 | ^MAGD(2006.79,28,1,82,0)=" ;%P2 is if output should be local or UCT time (L,U)"
|
---|
| 2804 | ^MAGD(2006.79,28,1,83,0)=" ;%P3 is 1 if the input just a time value?"
|
---|
| 2805 | ^MAGD(2006.79,28,1,84,0)=" N %TZ,%LTZ,%SN,%U,%H,%M,%T Q:'$L(%P1) """""
|
---|
| 2806 | ^MAGD(2006.79,28,1,85,0)=" S %T=$E(%P1_""0000"",1,8)"
|
---|
| 2807 | ^MAGD(2006.79,28,1,86,0)=" S %P2=$G(%P2),%P3=+$G(%P3),%TZ="""",%LTZ=$$TZ()"
|
---|
| 2808 | ^MAGD(2006.79,28,1,87,0)=" I '%P3 Q:(%T<18410102)!(%T>21141015) -1 ;Date Range Check"
|
---|
| 2809 | ^MAGD(2006.79,28,1,88,0)=" F %SN=""+"",""-"" I %P1[%SN D Q ;Find the timezone"
|
---|
| 2810 | ^MAGD(2006.79,28,1,89,0)=" . S %TZ=$P(%P1,%SN,2),%P1=$P(%P1,%SN) I %TZ'?4N S %TZ="""" Q"
|
---|
| 2811 | ^MAGD(2006.79,28,1,90,0)=" . S %TZ=%SN_%TZ"
|
---|
| 2812 | ^MAGD(2006.79,28,1,91,0)=" . Q"
|
---|
| 2813 | ^MAGD(2006.79,28,1,92,0)=" ;FM only supports time to seconds"
|
---|
| 2814 | ^MAGD(2006.79,28,1,93,0)=" S %P1=$P(%P1,""."")"
|
---|
| 2815 | ^MAGD(2006.79,28,1,94,0)=" ;See it just a Time value"
|
---|
| 2816 | ^MAGD(2006.79,28,1,95,0)=" I %P3 S %P1=""20000104""_%P1 ;Add a date"
|
---|
| 2817 | ^MAGD(2006.79,28,1,96,0)=" Q:($L(%P1)#2)!(%P1'?4.14N) -1 ;Length check"
|
---|
| 2818 | ^MAGD(2006.79,28,1,97,0)=" I $L(%P1)<8 S %P1=$E(%P1_""00000000"",1,8) ;Fill out to 8 digits"
|
---|
| 2819 | ^MAGD(2006.79,28,1,98,0)=" I %TZ="""" D"
|
---|
| 2820 | ^MAGD(2006.79,28,1,99,0)=" . S:%P2[""L"" %P2="""" ;If no TZ, assume local, don't need L."
|
---|
| 2821 | ^MAGD(2006.79,28,1,100,0)=" . S:%P2[""U"" %TZ=%LTZ ;give the local tz"
|
---|
| 2822 | ^MAGD(2006.79,28,1,101,0)=" ;"
|
---|
| 2823 | ^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)"
|
---|
| 2824 | ^MAGD(2006.79,28,1,103,0)=" ;%P1 is now in FM format"
|
---|
| 2825 | ^MAGD(2006.79,28,1,104,0)=" I %P1[""."",+$P(%P1,""."",2)=0 S %P1=$$FMADD(+%P1,-1)_"".24"""
|
---|
| 2826 | ^MAGD(2006.79,28,1,105,0)=" ;If HL7 tz and local tz are the same"
|
---|
| 2827 | ^MAGD(2006.79,28,1,106,0)=" I %P2[""L"",%TZ=%LTZ S %P2="""""
|
---|
| 2828 | ^MAGD(2006.79,28,1,107,0)=" I (%P2[""U"")!(%P2[""L""),%P1[""."" D ;Build UCT from data"
|
---|
| 2829 | ^MAGD(2006.79,28,1,108,0)=" . S %=$TR(%TZ,""+-"",""-+"") ;Reverse the sign"
|
---|
| 2830 | ^MAGD(2006.79,28,1,109,0)=" . S %H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)"
|
---|
| 2831 | ^MAGD(2006.79,28,1,110,0)=" . S %P1=$$FMADD(%P1,,%H,%M) Q"
|
---|
| 2832 | ^MAGD(2006.79,28,1,111,0)=" ;"
|
---|
| 2833 | ^MAGD(2006.79,28,1,112,0)=" I %P2[""L"",%P1[""."" D ;Build local from UCT"
|
---|
| 2834 | ^MAGD(2006.79,28,1,113,0)=" . S %=$$TZ(),%H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)"
|
---|
| 2835 | ^MAGD(2006.79,28,1,114,0)=" . S %P1=$$FMADD(%P1,,%H,%M) Q"
|
---|
| 2836 | ^MAGD(2006.79,28,1,115,0)=" Q +$S(%P3:"".""_$P(%P1,""."",2),1:%P1)"
|
---|
| 2837 | ^MAGD(2006.79,28,1,116,0)=" ;"
|
---|
| 2838 | ^MAGD(2006.79,28,1,117,0)="DOW(X,Y) ;Day of Week"
|
---|
| 2839 | ^MAGD(2006.79,28,1,118,0)=" N %Y,%M,%D,%H,%T D H I $G(Y) Q %Y"
|
---|
| 2840 | ^MAGD(2006.79,28,1,119,0)=" Q $P(""Sun^Mon^Tues^Wednes^Thurs^Fri^Satur"",""^"",%Y+1)_""day"""
|
---|
| 2841 | ^MAGD(2006.79,28,1,120,0)=" ;"
|
---|
| 2842 | ^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."
|
---|
| 2843 | ^MAGD(2006.79,28,1,122,0)=" N %H,%Y,X"
|
---|
| 2844 | ^MAGD(2006.79,28,1,123,0)=" S X1=$G(X1),X2=$G(X2),X3=$G(X3,1)"
|
---|
| 2845 | ^MAGD(2006.79,28,1,124,0)=" S:$$FR(X1) X1=0 S:$$FR(X2) X2=0 ;Check range, Use 0 for bad values"
|
---|
| 2846 | ^MAGD(2006.79,28,1,125,0)=" S X=X1 D H S X1=+%H,X1(1)=$P(%H,"","",2),X=X2 D H"
|
---|
| 2847 | ^MAGD(2006.79,28,1,126,0)=" ;Both FMDIFF and HDIFF come here."
|
---|
| 2848 | ^MAGD(2006.79,28,1,127,0)="D2 S X=(X1-%H) S:X3>1 X=X*86400+(X1(1)-$P(%H,"","",2))"
|
---|
| 2849 | ^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)"
|
---|
| 2850 | ^MAGD(2006.79,28,1,129,0)=" Q X"
|
---|
| 2851 | ^MAGD(2006.79,28,1,130,0)=" ;"
|
---|
| 2852 | ^MAGD(2006.79,28,1,131,0)="HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF."
|
---|
| 2853 | ^MAGD(2006.79,28,1,132,0)=" N X,%H,%T"
|
---|
| 2854 | ^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"
|
---|
| 2855 | ^MAGD(2006.79,28,1,134,0)=" S X3=$G(X3,1)"
|
---|
| 2856 | ^MAGD(2006.79,28,1,135,0)=" S X1(1)=$P(X1,"","",2),X1=+X1,%H=X2"
|
---|
| 2857 | ^MAGD(2006.79,28,1,136,0)=" G D2"
|
---|
| 2858 | ^MAGD(2006.79,28,1,137,0)=" ;"
|
---|
| 2859 | ^MAGD(2006.79,28,1,138,0)="HADD(X,D,H,M,S) ;Add to $H date"
|
---|
| 2860 | ^MAGD(2006.79,28,1,139,0)=" N %H,%T"
|
---|
| 2861 | ^MAGD(2006.79,28,1,140,0)=" Q:$$HR(X) -1 ;Check Range"
|
---|
| 2862 | ^MAGD(2006.79,28,1,141,0)=" S %H=+X,%T=$P(X,"","",2) D A2 Q %H_"",""_%T"
|
---|
| 2863 | ^MAGD(2006.79,28,1,142,0)=" ;"
|
---|
| 2864 | ^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"
|
---|
| 2865 | ^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"
|
---|
| 2866 | ^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"
|
---|
| 2867 | ^MAGD(2006.79,28,1,146,0)=" S %T=%T#86400"
|
---|
| 2868 | ^MAGD(2006.79,28,1,147,0)=" Q"
|
---|
| 2869 | ^MAGD(2006.79,28,1,148,0)=" ;"
|
---|
| 2870 | ^MAGD(2006.79,28,1,149,0)="FMADD(X,D,H,M,S) ;Add to FM date"
|
---|
| 2871 | ^MAGD(2006.79,28,1,150,0)=" N %H,%T,%P"
|
---|
| 2872 | ^MAGD(2006.79,28,1,151,0)=" Q:$$FR(X) -1 ;Check Range"
|
---|
| 2873 | ^MAGD(2006.79,28,1,152,0)=" S %P=X[""."",%H=$$F2H(X),%T=$P(%H,"","",2) D A2"
|
---|
| 2874 | ^MAGD(2006.79,28,1,153,0)=" I %P,%T=0 S %H=%H-1,%T=86400"
|
---|
| 2875 | ^MAGD(2006.79,28,1,154,0)=" Q $$H2F(%H_"",""_%T)"
|
---|
| 2876 | ^MAGD(2006.79,28,1,155,0)=" ;"
|
---|
| 2877 | ^MAGD(2006.79,28,1,156,0)="NOW() ;Current Date/time in FM."
|
---|
| 2878 | ^MAGD(2006.79,28,1,157,0)=" Q $$HTFM($H)"
|
---|
| 2879 | ^MAGD(2006.79,28,1,158,0)=" ;"
|
---|
| 2880 | ^MAGD(2006.79,28,1,159,0)="DT() ;Current Date in FM."
|
---|
| 2881 | ^MAGD(2006.79,28,1,160,0)=" Q $$HTFM($H,1)\1"
|
---|
| 2882 | ^MAGD(2006.79,28,1,161,0)=" ;"
|
---|
| 2883 | ^MAGD(2006.79,28,1,162,0)="SCH(SCH,LTM,FF) ;Find the next D/T given a schedule, start time."
|
---|
| 2884 | ^MAGD(2006.79,28,1,163,0)=" Q $$DECODE^XLFDT2"
|
---|
| 2885 | ^MAGD(2006.79,28,1,164,0)=" ;"
|
---|
| 2886 | ^MAGD(2006.79,28,1,165,0)="WITHIN(XLSCH,XLD) ;See if D/T is within schedule"
|
---|
| 2887 | ^MAGD(2006.79,28,1,166,0)=" G WITHIN^XLFDT4"
|
---|
| 2888 | ^MAGD(2006.79,28,1,167,0)=" ;"
|
---|
| 2889 | ^MAGD(2006.79,28,1,168,0)="SEC(%) ;Convert $H to seconds."
|
---|
| 2890 | ^MAGD(2006.79,28,1,169,0)=" I %?7.N.""."".N S %=$$FMTH(%) ;Check for FM date"
|
---|
| 2891 | ^MAGD(2006.79,28,1,170,0)=" Q 86400*%+$P(%,"","",2)"
|
---|
| 2892 | ^MAGD(2006.79,28,1,171,0)=" ;"
|
---|
| 2893 | ^MAGD(2006.79,28,1,172,0)="%H(%) ;Covert from seconds to $H"
|
---|
| 2894 | ^MAGD(2006.79,28,1,173,0)=" Q (%\86400)_"",""_(%#86400)"
|
---|
| 2895 | ^MAGD(2006.79,28,1,174,0)=" ;"
|
---|
| 2896 | ^MAGD(2006.79,28,1,175,0)="TZ() ;Return current Time Zone from Mailman parameter file"
|
---|
| 2897 | ^MAGD(2006.79,28,1,176,0)=" N %T,%S"
|
---|
| 2898 | ^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,""-+"")"
|
---|
| 2899 | ^MAGD(2006.79,28,1,178,0)=" Q %S_$E(100+%T,2,3)_$S(%T["".5"":""30"",1:""00"")"
|
---|
| 2900 | ^MAGD(2006.79,29,0)="XUMF333^3060410.105553"
|
---|
| 2901 | ^MAGD(2006.79,29,1,0)="^2006.791^356^356"
|
---|
| 2902 | ^MAGD(2006.79,29,1,1,0)="XUMF333 ;OIFO-OAK/RAM - Add HCS data types ;02/21/02"
|
---|
| 2903 | ^MAGD(2006.79,29,1,2,0)=" ;;8.0;KERNEL;**335**;Jul 10, 1995"
|
---|
| 2904 | ^MAGD(2006.79,29,1,3,0)=" ;"
|
---|
| 2905 | ^MAGD(2006.79,29,1,4,0)=" Q"
|
---|
| 2906 | ^MAGD(2006.79,29,1,5,0)=" ;"
|
---|
| 2907 | ^MAGD(2006.79,29,1,6,0)=" ;"
|
---|
| 2908 | ^MAGD(2006.79,29,1,7,0)="POST ; -- post installation XU*8*333"
|
---|
| 2909 | ^MAGD(2006.79,29,1,8,0)=" ;"
|
---|
| 2910 | ^MAGD(2006.79,29,1,9,0)=" N XUMF,IENS,IEN,FDA,I,HCS,XXX"
|
---|
| 2911 | ^MAGD(2006.79,29,1,10,0)=" ;"
|
---|
| 2912 | ^MAGD(2006.79,29,1,11,0)=" S XUMF=1"
|
---|
| 2913 | ^MAGD(2006.79,29,1,12,0)=" ;"
|
---|
| 2914 | ^MAGD(2006.79,29,1,13,0)=" D KM,KM1,KM2,KM3,STUFF"
|
---|
| 2915 | ^MAGD(2006.79,29,1,14,0)=" ;"
|
---|
| 2916 | ^MAGD(2006.79,29,1,15,0)=" Q"
|
---|
| 2917 | ^MAGD(2006.79,29,1,16,0)=" ;"
|
---|
| 2918 | ^MAGD(2006.79,29,1,17,0)="KM ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
|
---|
| 2919 | ^MAGD(2006.79,29,1,18,0)=" ;"
|
---|
| 2920 | ^MAGD(2006.79,29,1,19,0)=" N X,Y"
|
---|
| 2921 | ^MAGD(2006.79,29,1,20,0)=" ;"
|
---|
| 2922 | ^MAGD(2006.79,29,1,21,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
|
---|
| 2923 | ^MAGD(2006.79,29,1,22,0)=" S Y=""?+1,"""
|
---|
| 2924 | ^MAGD(2006.79,29,1,23,0)=" ;"
|
---|
| 2925 | ^MAGD(2006.79,29,1,24,0)=" S IENS=Y_X_"","""
|
---|
| 2926 | ^MAGD(2006.79,29,1,25,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
|
---|
| 2927 | ^MAGD(2006.79,29,1,26,0)=" S FDA(19.01,""?+2,?1,"",.01)=""XUMF IMF EDIT STATUS"""
|
---|
| 2928 | ^MAGD(2006.79,29,1,27,0)=" D UPDATE^DIE("""",""FDA"")"
|
---|
| 2929 | ^MAGD(2006.79,29,1,28,0)=" ;"
|
---|
| 2930 | ^MAGD(2006.79,29,1,29,0)=" Q"
|
---|
| 2931 | ^MAGD(2006.79,29,1,30,0)=" ;"
|
---|
| 2932 | ^MAGD(2006.79,29,1,31,0)="KM1 ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
|
---|
| 2933 | ^MAGD(2006.79,29,1,32,0)=" ;"
|
---|
| 2934 | ^MAGD(2006.79,29,1,33,0)=" N X,Y"
|
---|
| 2935 | ^MAGD(2006.79,29,1,34,0)=" ;"
|
---|
| 2936 | ^MAGD(2006.79,29,1,35,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
|
---|
| 2937 | ^MAGD(2006.79,29,1,36,0)=" S Y=""?+1,"""
|
---|
| 2938 | ^MAGD(2006.79,29,1,37,0)=" ;"
|
---|
| 2939 | ^MAGD(2006.79,29,1,38,0)=" S IENS=Y_X_"","""
|
---|
| 2940 | ^MAGD(2006.79,29,1,39,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
|
---|
| 2941 | ^MAGD(2006.79,29,1,40,0)=" S FDA(19.01,""?+3,?1,"",.01)=""XUMF LOAD INSTITUTION"""
|
---|
| 2942 | ^MAGD(2006.79,29,1,41,0)=" D UPDATE^DIE("""",""FDA"")"
|
---|
| 2943 | ^MAGD(2006.79,29,1,42,0)=" ;"
|
---|
| 2944 | ^MAGD(2006.79,29,1,43,0)=" Q"
|
---|
| 2945 | ^MAGD(2006.79,29,1,44,0)=" ;"
|
---|
| 2946 | ^MAGD(2006.79,29,1,45,0)="KM2 ; -- add XUMF IMF EDIT STATUS to XUKERNEL"
|
---|
| 2947 | ^MAGD(2006.79,29,1,46,0)=" ;"
|
---|
| 2948 | ^MAGD(2006.79,29,1,47,0)=" N X,Y"
|
---|
| 2949 | ^MAGD(2006.79,29,1,48,0)=" ;"
|
---|
| 2950 | ^MAGD(2006.79,29,1,49,0)=" S X=$$FIND1^DIC(19,,""B"",""XUKERNEL"")"
|
---|
| 2951 | ^MAGD(2006.79,29,1,50,0)=" S Y=""?+1,"""
|
---|
| 2952 | ^MAGD(2006.79,29,1,51,0)=" ;"
|
---|
| 2953 | ^MAGD(2006.79,29,1,52,0)=" S IENS=Y_X_"","""
|
---|
| 2954 | ^MAGD(2006.79,29,1,53,0)=" S FDA(19,""?1,"",.01)=""XUKERNEL"""
|
---|
| 2955 | ^MAGD(2006.79,29,1,54,0)=" S FDA(19.01,""?+3,?1,"",.01)=""Patch XU*8*335 clean 4.1 and 4"""
|
---|
| 2956 | ^MAGD(2006.79,29,1,55,0)=" D UPDATE^DIE("""",""FDA"")"
|
---|
| 2957 | ^MAGD(2006.79,29,1,56,0)=" ;"
|
---|
| 2958 | ^MAGD(2006.79,29,1,57,0)=" Q"
|
---|
| 2959 | ^MAGD(2006.79,29,1,58,0)=" ;"
|
---|
| 2960 | ^MAGD(2006.79,29,1,59,0)="KM3 ; -- remove XUMF333 clean 4.1 and 4 if present"
|
---|
| 2961 | ^MAGD(2006.79,29,1,60,0)=" ;"
|
---|
| 2962 | ^MAGD(2006.79,29,1,61,0)=" N X,IENS,FDA"
|
---|
| 2963 | ^MAGD(2006.79,29,1,62,0)=" ;"
|
---|
| 2964 | ^MAGD(2006.79,29,1,63,0)=" S X=$$FIND1^DIC(19,,""B"",""XUMF333 clean 4.1 and 4"")"
|
---|
| 2965 | ^MAGD(2006.79,29,1,64,0)=" ;"
|
---|
| 2966 | ^MAGD(2006.79,29,1,65,0)=" Q:'X"
|
---|
| 2967 | ^MAGD(2006.79,29,1,66,0)=" ;"
|
---|
| 2968 | ^MAGD(2006.79,29,1,67,0)=" S IENS=X_"","""
|
---|
| 2969 | ^MAGD(2006.79,29,1,68,0)=" S FDA(19,IENS,.01)=""@"""
|
---|
| 2970 | ^MAGD(2006.79,29,1,69,0)=" D UPDATE^DIE("""",""FDA"")"
|
---|
| 2971 | ^MAGD(2006.79,29,1,70,0)=" ;"
|
---|
| 2972 | ^MAGD(2006.79,29,1,71,0)=" Q"
|
---|
| 2973 | ^MAGD(2006.79,29,1,72,0)=" ;"
|
---|
| 2974 | ^MAGD(2006.79,29,1,73,0)="STUFF ;"
|
---|
| 2975 | ^MAGD(2006.79,29,1,74,0)=" ;"
|
---|
| 2976 | ^MAGD(2006.79,29,1,75,0)=" S IEN=$O(^DIC(4.1,""B"",""HCS"",0))"
|
---|
| 2977 | ^MAGD(2006.79,29,1,76,0)=" S IENS=$S(IEN:IEN_"","",1:""+1,"")"
|
---|
| 2978 | ^MAGD(2006.79,29,1,77,0)=" K FDA"
|
---|
| 2979 | ^MAGD(2006.79,29,1,78,0)=" S FDA(4.1,IENS,.01)=""HCS"""
|
---|
| 2980 | ^MAGD(2006.79,29,1,79,0)=" S FDA(4.1,IENS,1)=""HEALTH CARE SYSTEM"""
|
---|
| 2981 | ^MAGD(2006.79,29,1,80,0)=" S FDA(4.1,IENS,3)=""LOCAL"""
|
---|
| 2982 | ^MAGD(2006.79,29,1,81,0)=" D UPDATE^DIE(""E"",""FDA"")"
|
---|
| 2983 | ^MAGD(2006.79,29,1,82,0)=" ;"
|
---|
| 2984 | ^MAGD(2006.79,29,1,83,0)=" S HCS="""""
|
---|
| 2985 | ^MAGD(2006.79,29,1,84,0)=" F XXX=1:1 D Q:HCS="""""
|
---|
| 2986 | ^MAGD(2006.79,29,1,85,0)=" .S HCS=$P($T(HCS+XXX),"";;"",2)"
|
---|
| 2987 | ^MAGD(2006.79,29,1,86,0)=" .S IEN=$S(HCS="""":0,1:$O(^DIC(4,""B"",HCS,0)))"
|
---|
| 2988 | ^MAGD(2006.79,29,1,87,0)=" .S IENS=$S(IEN:IEN_"","",1:""+1,"")"
|
---|
| 2989 | ^MAGD(2006.79,29,1,88,0)=" .;"
|
---|
| 2990 | ^MAGD(2006.79,29,1,89,0)=" .K FDA"
|
---|
| 2991 | ^MAGD(2006.79,29,1,90,0)=" .S FDA(4,IENS,.01)=HCS"
|
---|
| 2992 | ^MAGD(2006.79,29,1,91,0)=" .S FDA(4,IENS,11)=""LOCAL"""
|
---|
| 2993 | ^MAGD(2006.79,29,1,92,0)=" .S FDA(4,IENS,13)=""HCS"""
|
---|
| 2994 | ^MAGD(2006.79,29,1,93,0)=" .D UPDATE^DIE(""E"",""FDA"")"
|
---|
| 2995 | ^MAGD(2006.79,29,1,94,0)=" ;"
|
---|
| 2996 | ^MAGD(2006.79,29,1,95,0)=" Q"
|
---|
| 2997 | ^MAGD(2006.79,29,1,96,0)=" ;"
|
---|
| 2998 | ^MAGD(2006.79,29,1,97,0)="HCS ;"
|
---|
| 2999 | ^MAGD(2006.79,29,1,98,0)=" ;;VA GREATER LOS ANGELES (691)"
|
---|
| 3000 | ^MAGD(2006.79,29,1,99,0)=" ;;VA HEARTLAND-EAST VISN15 (657)"
|
---|
| 3001 | ^MAGD(2006.79,29,1,100,0)=" ;;VA HEARTLAND-WEST VISN15 (589)"
|
---|
| 3002 | ^MAGD(2006.79,29,1,101,0)=" ;;VA CHICAGO HSC (537)"
|
---|
| 3003 | ^MAGD(2006.79,29,1,102,0)=" ;;CENTRAL PLAINS NETWORK (636)"
|
---|
| 3004 | ^MAGD(2006.79,29,1,103,0)=" ;;MONTANA HCS (436)"
|
---|
| 3005 | ^MAGD(2006.79,29,1,104,0)=" ;;VA PACIFIC ISLANDS HCS (459)"
|
---|
| 3006 | ^MAGD(2006.79,29,1,105,0)=" ;;NEW MEXICO HCS (501)"
|
---|
| 3007 | ^MAGD(2006.79,29,1,106,0)=" ;;AMARILLO HCS (504)"
|
---|
| 3008 | ^MAGD(2006.79,29,1,107,0)=" ;;MARYLAND HCS (512)"
|
---|
| 3009 | ^MAGD(2006.79,29,1,108,0)=" ;;WEST TEXAS HCS (519)"
|
---|
| 3010 | ^MAGD(2006.79,29,1,109,0)=" ;;BOSTON HCS (523)"
|
---|
| 3011 | ^MAGD(2006.79,29,1,110,0)=" ;;UPSTATE NEW YORK HCS (528)"
|
---|
| 3012 | ^MAGD(2006.79,29,1,111,0)=" ;;NORTH TEXAS HCS (549)"
|
---|
| 3013 | ^MAGD(2006.79,29,1,112,0)=" ;;EASTERN COLORADO HCS (554)"
|
---|
| 3014 | ^MAGD(2006.79,29,1,113,0)=" ;;NEW JERSEY HCS (561)"
|
---|
| 3015 | ^MAGD(2006.79,29,1,114,0)=" ;;BLACK HILLS HCS (568)"
|
---|
| 3016 | ^MAGD(2006.79,29,1,115,0)=" ;;CENTRAL CALIFORNIA HCS (570)"
|
---|
| 3017 | ^MAGD(2006.79,29,1,116,0)=" ;;N FLORIDA/S GEORGIA HCS (573)"
|
---|
| 3018 | ^MAGD(2006.79,29,1,117,0)=" ;;GREATER NEBRASKA HCS (597)"
|
---|
| 3019 | ^MAGD(2006.79,29,1,118,0)=" ;;CENTRAL ARKANSAS HCS (598)"
|
---|
| 3020 | ^MAGD(2006.79,29,1,119,0)=" ;;LONG BEACH HCS (600)"
|
---|
| 3021 | ^MAGD(2006.79,29,1,120,0)=" ;;CENTRAL ALABAMA HCS (619)"
|
---|
| 3022 | ^MAGD(2006.79,29,1,121,0)=" ;;HUDSON VALLEY HCS VAMC (620)"
|
---|
| 3023 | ^MAGD(2006.79,29,1,122,0)=" ;;TENNESSEE VALLEY HCS (626)"
|
---|
| 3024 | ^MAGD(2006.79,29,1,123,0)=" ;;PALO ALTO HCS (640)"
|
---|
| 3025 | ^MAGD(2006.79,29,1,124,0)=" ;;PITTSBURGH HCS (646)"
|
---|
| 3026 | ^MAGD(2006.79,29,1,125,0)=" ;;ROSEBURG HCS (653)"
|
---|
| 3027 | ^MAGD(2006.79,29,1,126,0)=" ;;SIERRA NEVADA HCS (654)"
|
---|
| 3028 | ^MAGD(2006.79,29,1,127,0)=" ;;SALT LAKE CITY HCS (660)"
|
---|
| 3029 | ^MAGD(2006.79,29,1,128,0)=" ;;PUGET SOUND HCS (663)"
|
---|
| 3030 | ^MAGD(2006.79,29,1,129,0)=" ;;SAN DIEGO HCS (664)"
|
---|
| 3031 | ^MAGD(2006.79,29,1,130,0)=" ;;SOUTH TEXAS HCS (671)"
|
---|
| 3032 | ^MAGD(2006.79,29,1,131,0)=" ;;CENTRAL TEXAS HCS (674)"
|
---|
| 3033 | ^MAGD(2006.79,29,1,132,0)=" ;;EASTERN KANSAS HCS (677)"
|
---|
| 3034 | ^MAGD(2006.79,29,1,133,0)=" ;;SOUTHERN ARIZONA VA HCS (678)"
|
---|
| 3035 | ^MAGD(2006.79,29,1,134,0)=" ;;CONNECTICUT HCS (689)"
|
---|
| 3036 | ^MAGD(2006.79,29,1,135,0)=" ;;EL PASO VA HCS (756)"
|
---|
| 3037 | ^MAGD(2006.79,29,1,136,0)=" ;;NEW YORK HHS (630)"
|
---|
| 3038 | ^MAGD(2006.79,29,1,137,0)=" ;"
|
---|
| 3039 | ^MAGD(2006.79,29,1,138,0)=" ; do not include"
|
---|
| 3040 | ^MAGD(2006.79,29,1,139,0)=" ;;EASTERN COLORADO HCS (554A4)"
|
---|
| 3041 | ^MAGD(2006.79,29,1,140,0)=" ;;SOUTHERN COLORADO HCS"
|
---|
| 3042 | ^MAGD(2006.79,29,1,141,0)=" ;;CENTRAL IOWA HCS (555)"
|
---|
| 3043 | ^MAGD(2006.79,29,1,142,0)=" ;;ILLIANA HCS (550)"
|
---|
| 3044 | ^MAGD(2006.79,29,1,143,0)=" ;;NORTHERN CALIFORNIA HCS (612)"
|
---|
| 3045 | ^MAGD(2006.79,29,1,144,0)=" ;;SOUTHERN NEVADA HCS (593)"
|
---|
| 3046 | ^MAGD(2006.79,29,1,145,0)=" ;;NORTHERN ARIZONA HCS (649)"
|
---|
| 3047 | ^MAGD(2006.79,29,1,146,0)=" ;"
|
---|
| 3048 | ^MAGD(2006.79,29,1,147,0)=" Q"
|
---|
| 3049 | ^MAGD(2006.79,29,1,148,0)=" ;"
|
---|
| 3050 | ^MAGD(2006.79,29,1,149,0)="CHK ; -- check site updating required"
|
---|
| 3051 | ^MAGD(2006.79,29,1,150,0)=" ;"
|
---|
| 3052 | ^MAGD(2006.79,29,1,151,0)=" N STA,IEN,FLAG,CHK"
|
---|
| 3053 | ^MAGD(2006.79,29,1,152,0)=" ;"
|
---|
| 3054 | ^MAGD(2006.79,29,1,153,0)=" S STA=$$STA^XUAF4(+$G(DUZ(2)))"
|
---|
| 3055 | ^MAGD(2006.79,29,1,154,0)=" ;"
|
---|
| 3056 | ^MAGD(2006.79,29,1,155,0)=" I STA="""" W !!,""DUZ not defined. Please log on."" Q"
|
---|
| 3057 | ^MAGD(2006.79,29,1,156,0)=" ;"
|
---|
| 3058 | ^MAGD(2006.79,29,1,157,0)=" W @IOF,!,STA,"" "",$P($$NS^XUAF4(+DUZ(2)),U)"
|
---|
| 3059 | ^MAGD(2006.79,29,1,158,0)=" ;"
|
---|
| 3060 | ^MAGD(2006.79,29,1,159,0)=" S CHK=$$INST^XUMF333(+DUZ(2),.ERR)"
|
---|
| 3061 | ^MAGD(2006.79,29,1,160,0)=" I CHK=1 D"
|
---|
| 3062 | ^MAGD(2006.79,29,1,161,0)=" .W !!?5,""MISSING DATA - please fix"",!"
|
---|
| 3063 | ^MAGD(2006.79,29,1,162,0)=" .S I=0 F S I=$O(ERR(""FATAL"",I)) Q:'I D"
|
---|
| 3064 | ^MAGD(2006.79,29,1,163,0)=" ..W !?5,ERR(""FATAL"",I)"
|
---|
| 3065 | ^MAGD(2006.79,29,1,164,0)=" I CHK'=1 W "" is okay"""
|
---|
| 3066 | ^MAGD(2006.79,29,1,165,0)=" ;"
|
---|
| 3067 | ^MAGD(2006.79,29,1,166,0)=" S STA=STA_""A"""
|
---|
| 3068 | ^MAGD(2006.79,29,1,167,0)=" F S STA=$O(^DIC(4,""D"",STA)) Q:STA="""" D Q:$G(FLAG)"
|
---|
| 3069 | ^MAGD(2006.79,29,1,168,0)=" .I $E($$STA^XUAF4(DUZ(2)),1,3)'=$E(STA,1,3) S FLAG=1 Q"
|
---|
| 3070 | ^MAGD(2006.79,29,1,169,0)=" .S IEN=$$IEN^XUAF4(STA)"
|
---|
| 3071 | ^MAGD(2006.79,29,1,170,0)=" .S CHK=$$INST^XUMF333(+IEN,.ERR)"
|
---|
| 3072 | ^MAGD(2006.79,29,1,171,0)=" .W !!,STA,"" "",$P($$NS^XUAF4(+IEN),U)"
|
---|
| 3073 | ^MAGD(2006.79,29,1,172,0)=" .I CHK'=1 W "" is okay"" Q"
|
---|
| 3074 | ^MAGD(2006.79,29,1,173,0)=" .I CHK=1 D"
|
---|
| 3075 | ^MAGD(2006.79,29,1,174,0)=" ..W "" is MISSING DATA - please fix"",!"
|
---|
| 3076 | ^MAGD(2006.79,29,1,175,0)=" ..S I=0 F S I=$O(ERR(""FATAL"",I)) Q:'I D"
|
---|
| 3077 | ^MAGD(2006.79,29,1,176,0)=" ...W !?5,ERR(""FATAL"",I)"
|
---|
| 3078 | ^MAGD(2006.79,29,1,177,0)=" .K ERR"
|
---|
| 3079 | ^MAGD(2006.79,29,1,178,0)=" ;"
|
---|
| 3080 | ^MAGD(2006.79,29,1,179,0)=" ;"
|
---|
| 3081 | ^MAGD(2006.79,29,1,180,0)=" Q"
|
---|
| 3082 | ^MAGD(2006.79,29,1,181,0)=" ;"
|
---|
| 3083 | ^MAGD(2006.79,29,1,182,0)="INST(IEN,ERR) ; -- validate Institution entry FALSE=valid"
|
---|
| 3084 | ^MAGD(2006.79,29,1,183,0)=" ;"
|
---|
| 3085 | ^MAGD(2006.79,29,1,184,0)=" Q:'$G(IEN) ""IEN null"""
|
---|
| 3086 | ^MAGD(2006.79,29,1,185,0)=" ;"
|
---|
| 3087 | ^MAGD(2006.79,29,1,186,0)=" S CNT=1"
|
---|
| 3088 | ^MAGD(2006.79,29,1,187,0)=" ;"
|
---|
| 3089 | ^MAGD(2006.79,29,1,188,0)=" D ZERO(IEN,.ERR,.CNT)"
|
---|
| 3090 | ^MAGD(2006.79,29,1,189,0)=" D ADD1(IEN,.ERR,.CNT)"
|
---|
| 3091 | ^MAGD(2006.79,29,1,190,0)=" D ADD2(IEN,.ERR,.CNT)"
|
---|
| 3092 | ^MAGD(2006.79,29,1,191,0)=" D FTYP(IEN,.ERR,.CNT)"
|
---|
| 3093 | ^MAGD(2006.79,29,1,192,0)=" D ND99(IEN,.ERR,.CNT)"
|
---|
| 3094 | ^MAGD(2006.79,29,1,193,0)=" ;"
|
---|
| 3095 | ^MAGD(2006.79,29,1,194,0)=" Q $S($D(ERR(""FATAL"")):1,$D(ERR(""WARNING"")):2,1:0)"
|
---|
| 3096 | ^MAGD(2006.79,29,1,195,0)=" ;"
|
---|
| 3097 | ^MAGD(2006.79,29,1,196,0)="ZERO(IEN,ERR,CNT) ; -- zero node"
|
---|
| 3098 | ^MAGD(2006.79,29,1,197,0)=" ;"
|
---|
| 3099 | ^MAGD(2006.79,29,1,198,0)=" N X"
|
---|
| 3100 | ^MAGD(2006.79,29,1,199,0)=" ;"
|
---|
| 3101 | ^MAGD(2006.79,29,1,200,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
|
---|
| 3102 | ^MAGD(2006.79,29,1,201,0)=" ;"
|
---|
| 3103 | ^MAGD(2006.79,29,1,202,0)=" S X=$G(^DIC(4,+IEN,0))"
|
---|
| 3104 | ^MAGD(2006.79,29,1,203,0)=" I $P(X,U,2)="""" D"
|
---|
| 3105 | ^MAGD(2006.79,29,1,204,0)=" .S ERR(""FATAL"",CNT)=""STATE is missing"",CNT=CNT+1"
|
---|
| 3106 | ^MAGD(2006.79,29,1,205,0)=" ;"
|
---|
| 3107 | ^MAGD(2006.79,29,1,206,0)=" Q"
|
---|
| 3108 | ^MAGD(2006.79,29,1,207,0)=" ;"
|
---|
| 3109 | ^MAGD(2006.79,29,1,208,0)="ADD1(IEN,ERR,CNT) ; -- address node"
|
---|
| 3110 | ^MAGD(2006.79,29,1,209,0)=" ;"
|
---|
| 3111 | ^MAGD(2006.79,29,1,210,0)=" N X,I"
|
---|
| 3112 | ^MAGD(2006.79,29,1,211,0)=" ;"
|
---|
| 3113 | ^MAGD(2006.79,29,1,212,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
|
---|
| 3114 | ^MAGD(2006.79,29,1,213,0)=" ;"
|
---|
| 3115 | ^MAGD(2006.79,29,1,214,0)=" S X=$G(^DIC(4,+IEN,1))"
|
---|
| 3116 | ^MAGD(2006.79,29,1,215,0)=" I $P(X,U,1)="""" D"
|
---|
| 3117 | ^MAGD(2006.79,29,1,216,0)=" .S ERR(""FATAL"",CNT)=""Physical address St. line 1 missing"""
|
---|
| 3118 | ^MAGD(2006.79,29,1,217,0)=" .S CNT=CNT+1"
|
---|
| 3119 | ^MAGD(2006.79,29,1,218,0)=" I $P(X,U,3)="""" D"
|
---|
| 3120 | ^MAGD(2006.79,29,1,219,0)=" .S ERR(""FATAL"",CNT)=""Physical address City missing"""
|
---|
| 3121 | ^MAGD(2006.79,29,1,220,0)=" .S CNT=CNT+1"
|
---|
| 3122 | ^MAGD(2006.79,29,1,221,0)=" I $P(X,U,4)="""" D"
|
---|
| 3123 | ^MAGD(2006.79,29,1,222,0)=" .S ERR(""FATAL"",CNT)=""Physical address ZIP missing"""
|
---|
| 3124 | ^MAGD(2006.79,29,1,223,0)=" .S CNT=CNT+1"
|
---|
| 3125 | ^MAGD(2006.79,29,1,224,0)=" I $P(X,U,2)="""" D"
|
---|
| 3126 | ^MAGD(2006.79,29,1,225,0)=" .S ERR(""WARNING"",CNT)=""Physical address St. line 2 missing"""
|
---|
| 3127 | ^MAGD(2006.79,29,1,226,0)=" .S CNT=CNT+1"
|
---|
| 3128 | ^MAGD(2006.79,29,1,227,0)=" ;"
|
---|
| 3129 | ^MAGD(2006.79,29,1,228,0)=" Q"
|
---|
| 3130 | ^MAGD(2006.79,29,1,229,0)=" ;"
|
---|
| 3131 | ^MAGD(2006.79,29,1,230,0)="ADD2(IEN,ERR,CNT) ; -- mailing address node"
|
---|
| 3132 | ^MAGD(2006.79,29,1,231,0)=" ;"
|
---|
| 3133 | ^MAGD(2006.79,29,1,232,0)=" N X,I"
|
---|
| 3134 | ^MAGD(2006.79,29,1,233,0)=" ;"
|
---|
| 3135 | ^MAGD(2006.79,29,1,234,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
|
---|
| 3136 | ^MAGD(2006.79,29,1,235,0)=" ;"
|
---|
| 3137 | ^MAGD(2006.79,29,1,236,0)=" S X=$G(^DIC(4,+IEN,4))"
|
---|
| 3138 | ^MAGD(2006.79,29,1,237,0)=" I $P(X,U,1)="""" D"
|
---|
| 3139 | ^MAGD(2006.79,29,1,238,0)=" .S ERR(""FATAL"",CNT)=""Mailing address St. line 1 missing"""
|
---|
| 3140 | ^MAGD(2006.79,29,1,239,0)=" .S CNT=CNT+1"
|
---|
| 3141 | ^MAGD(2006.79,29,1,240,0)=" I $P(X,U,3)="""" D"
|
---|
| 3142 | ^MAGD(2006.79,29,1,241,0)=" .S ERR(""FATAL"",CNT)=""Mailing address City missing"""
|
---|
| 3143 | ^MAGD(2006.79,29,1,242,0)=" .S CNT=CNT+1"
|
---|
| 3144 | ^MAGD(2006.79,29,1,243,0)=" I $P(X,U,4)="""" D"
|
---|
| 3145 | ^MAGD(2006.79,29,1,244,0)=" .S ERR(""FATAL"",CNT)=""Mailing address State missing"""
|
---|
| 3146 | ^MAGD(2006.79,29,1,245,0)=" .S CNT=CNT+1"
|
---|
| 3147 | ^MAGD(2006.79,29,1,246,0)=" I $P(X,U,5)="""" D"
|
---|
| 3148 | ^MAGD(2006.79,29,1,247,0)=" .S ERR(""FATAL"",CNT)=""Mailing address ZIP missing"""
|
---|
| 3149 | ^MAGD(2006.79,29,1,248,0)=" .S CNT=CNT+1"
|
---|
| 3150 | ^MAGD(2006.79,29,1,249,0)=" I $P(X,U,2)="""" D"
|
---|
| 3151 | ^MAGD(2006.79,29,1,250,0)=" .S ERR(""WARNING"",CNT)=""Mailing address St. line 2 missing"""
|
---|
| 3152 | ^MAGD(2006.79,29,1,251,0)=" .S CNT=CNT+1"
|
---|
| 3153 | ^MAGD(2006.79,29,1,252,0)=" ;"
|
---|
| 3154 | ^MAGD(2006.79,29,1,253,0)=" Q"
|
---|
| 3155 | ^MAGD(2006.79,29,1,254,0)=" ;"
|
---|
| 3156 | ^MAGD(2006.79,29,1,255,0)="FTYP(IEN,ERR,CNT) ; -- facility type node"
|
---|
| 3157 | ^MAGD(2006.79,29,1,256,0)=" ;"
|
---|
| 3158 | ^MAGD(2006.79,29,1,257,0)=" N X"
|
---|
| 3159 | ^MAGD(2006.79,29,1,258,0)=" ;"
|
---|
| 3160 | ^MAGD(2006.79,29,1,259,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
|
---|
| 3161 | ^MAGD(2006.79,29,1,260,0)=" ;"
|
---|
| 3162 | ^MAGD(2006.79,29,1,261,0)=" S X=$G(^DIC(4,+IEN,3))"
|
---|
| 3163 | ^MAGD(2006.79,29,1,262,0)=" I 'X D"
|
---|
| 3164 | ^MAGD(2006.79,29,1,263,0)=" .S ERR(""FATAL"",CNT)=""FACILITY TYPE is missing"",CNT=CNT+1"
|
---|
| 3165 | ^MAGD(2006.79,29,1,264,0)=" I $P($G(^DIC(4.1,+X,0)),U,4)'=""N"" D"
|
---|
| 3166 | ^MAGD(2006.79,29,1,265,0)=" .S ERR(""FATAL"",CNT)=""FACILITY TYPE is not NATIONAL"",CNT=CNT+1"
|
---|
| 3167 | ^MAGD(2006.79,29,1,266,0)=" ;"
|
---|
| 3168 | ^MAGD(2006.79,29,1,267,0)=" Q"
|
---|
| 3169 | ^MAGD(2006.79,29,1,268,0)=" ;"
|
---|
| 3170 | ^MAGD(2006.79,29,1,269,0)="ND99(IEN,ERR,CNT) ; -- 99 node"
|
---|
| 3171 | ^MAGD(2006.79,29,1,270,0)=" ;"
|
---|
| 3172 | ^MAGD(2006.79,29,1,271,0)=" N X"
|
---|
| 3173 | ^MAGD(2006.79,29,1,272,0)=" ;"
|
---|
| 3174 | ^MAGD(2006.79,29,1,273,0)=" S CNT=$G(CNT) S:'CNT CNT=1"
|
---|
| 3175 | ^MAGD(2006.79,29,1,274,0)=" ;"
|
---|
| 3176 | ^MAGD(2006.79,29,1,275,0)=" S X=$G(^DIC(4,+IEN,99))"
|
---|
| 3177 | ^MAGD(2006.79,29,1,276,0)=" I $P(X,U,3)="""" D"
|
---|
| 3178 | ^MAGD(2006.79,29,1,277,0)=" .S ERR(""FATAL"",CNT)=""OFFICIAL VA NAME is missing"",CNT=CNT+1"
|
---|
| 3179 | ^MAGD(2006.79,29,1,278,0)=" I ($P(X,U,4))&($E($$NS^XUAF4(+IEN),1,2)'=""ZZ"") D"
|
---|
| 3180 | ^MAGD(2006.79,29,1,279,0)=" .S ERR(""FATAL"",CNT)=""Inactive facility NAME not ZZ'd"",CNT=CNT+1"
|
---|
| 3181 | ^MAGD(2006.79,29,1,280,0)=" ;"
|
---|
| 3182 | ^MAGD(2006.79,29,1,281,0)=" Q"
|
---|
| 3183 | ^MAGD(2006.79,29,1,282,0)=" ;"
|
---|
| 3184 | ^MAGD(2006.79,29,1,283,0)="C4 ; -- clean up Institution file"
|
---|
| 3185 | ^MAGD(2006.79,29,1,284,0)=" ;"
|
---|
| 3186 | ^MAGD(2006.79,29,1,285,0)=" D RIP,CFTYP,GET"
|
---|
| 3187 | ^MAGD(2006.79,29,1,286,0)=" ;"
|
---|
| 3188 | ^MAGD(2006.79,29,1,287,0)=" Q"
|
---|
| 3189 | ^MAGD(2006.79,29,1,288,0)=" ;"
|
---|
| 3190 | ^MAGD(2006.79,29,1,289,0)="RIP ; -- remove from all inactive and local the associations visn & parent"
|
---|
| 3191 | ^MAGD(2006.79,29,1,290,0)=" ;"
|
---|
| 3192 | ^MAGD(2006.79,29,1,291,0)=" N IEN"
|
---|
| 3193 | ^MAGD(2006.79,29,1,292,0)=" ;"
|
---|
| 3194 | ^MAGD(2006.79,29,1,293,0)=" S IEN=0"
|
---|
| 3195 | ^MAGD(2006.79,29,1,294,0)=" F S IEN=$O(^DIC(4,IEN)) Q:'IEN D"
|
---|
| 3196 | ^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"
|
---|
| 3197 | ^MAGD(2006.79,29,1,296,0)=" .D IFF^XUMF333(IEN)"
|
---|
| 3198 | ^MAGD(2006.79,29,1,297,0)=" ;"
|
---|
| 3199 | ^MAGD(2006.79,29,1,298,0)=" Q"
|
---|
| 3200 | ^MAGD(2006.79,29,1,299,0)=" ;"
|
---|
| 3201 | ^MAGD(2006.79,29,1,300,0)="IFF(IEN) ; -- inactive facility remove VISN and parent association"
|
---|
| 3202 | ^MAGD(2006.79,29,1,301,0)=" ;"
|
---|
| 3203 | ^MAGD(2006.79,29,1,302,0)=" N FDA,IENS,XUMF"
|
---|
| 3204 | ^MAGD(2006.79,29,1,303,0)=" ;"
|
---|
| 3205 | ^MAGD(2006.79,29,1,304,0)=" S XUMF=1"
|
---|
| 3206 | ^MAGD(2006.79,29,1,305,0)=" ;"
|
---|
| 3207 | ^MAGD(2006.79,29,1,306,0)=" S IENS=""1,""_IEN_"","""
|
---|
| 3208 | ^MAGD(2006.79,29,1,307,0)=" S FDA(4.014,IENS,.01)=""@"""
|
---|
| 3209 | ^MAGD(2006.79,29,1,308,0)=" S IENS=""2,""_IEN_"","""
|
---|
| 3210 | ^MAGD(2006.79,29,1,309,0)=" S FDA(4.014,IENS,.01)=""@"""
|
---|
| 3211 | ^MAGD(2006.79,29,1,310,0)=" D FILE^DIE(""E"",""FDA"")"
|
---|
| 3212 | ^MAGD(2006.79,29,1,311,0)=" ;"
|
---|
| 3213 | ^MAGD(2006.79,29,1,312,0)=" Q"
|
---|
| 3214 | ^MAGD(2006.79,29,1,313,0)=" ;"
|
---|
| 3215 | ^MAGD(2006.79,29,1,314,0)="CFTYP ; - clean 4.1"
|
---|
| 3216 | ^MAGD(2006.79,29,1,315,0)=" ;"
|
---|
| 3217 | ^MAGD(2006.79,29,1,316,0)=" N FDA,IENS,XUMF,IEN"
|
---|
| 3218 | ^MAGD(2006.79,29,1,317,0)=" ;"
|
---|
| 3219 | ^MAGD(2006.79,29,1,318,0)=" M ^TMP(""XUMF 4.1"",$J)=^DIC(4.1)"
|
---|
| 3220 | ^MAGD(2006.79,29,1,319,0)=" ;"
|
---|
| 3221 | ^MAGD(2006.79,29,1,320,0)=" S XUMF=1"
|
---|
| 3222 | ^MAGD(2006.79,29,1,321,0)=" ;"
|
---|
| 3223 | ^MAGD(2006.79,29,1,322,0)=" S IEN=0"
|
---|
| 3224 | ^MAGD(2006.79,29,1,323,0)=" F S IEN=$O(^DIC(4.1,IEN)) Q:'IEN D"
|
---|
| 3225 | ^MAGD(2006.79,29,1,324,0)=" .S IENS=IEN_"","""
|
---|
| 3226 | ^MAGD(2006.79,29,1,325,0)=" .K FDA"
|
---|
| 3227 | ^MAGD(2006.79,29,1,326,0)=" .S FDA(4.1,IENS,.01)=""@"""
|
---|
| 3228 | ^MAGD(2006.79,29,1,327,0)=" .D FILE^DIE(""E"",""FDA"")"
|
---|
| 3229 | ^MAGD(2006.79,29,1,328,0)=" ;"
|
---|
| 3230 | ^MAGD(2006.79,29,1,329,0)=" S IEN=0"
|
---|
| 3231 | ^MAGD(2006.79,29,1,330,0)=" F S IEN=$O(^DIC(4,IEN)) Q:'IEN D"
|
---|
| 3232 | ^MAGD(2006.79,29,1,331,0)=" .S IENS=IEN_"","""
|
---|
| 3233 | ^MAGD(2006.79,29,1,332,0)=" .K FDA"
|
---|
| 3234 | ^MAGD(2006.79,29,1,333,0)=" .S FDA(4,IENS,13)=""@"""
|
---|
| 3235 | ^MAGD(2006.79,29,1,334,0)=" .D FILE^DIE(""E"",""FDA"")"
|
---|
| 3236 | ^MAGD(2006.79,29,1,335,0)=" ;"
|
---|
| 3237 | ^MAGD(2006.79,29,1,336,0)=" Q"
|
---|
| 3238 | ^MAGD(2006.79,29,1,337,0)=" ;"
|
---|
| 3239 | ^MAGD(2006.79,29,1,338,0)="GET ; -- get Institution Master File (IMF) and Facility Types"
|
---|
| 3240 | ^MAGD(2006.79,29,1,339,0)=" ;"
|
---|
| 3241 | ^MAGD(2006.79,29,1,340,0)=" W !!,""...getting Facility Types - wait please 5 min..."""
|
---|
| 3242 | ^MAGD(2006.79,29,1,341,0)=" D LOAD^XUMF(4.1)"
|
---|
| 3243 | ^MAGD(2006.79,29,1,342,0)=" W !!,""...getting Institutions - wait please 10 min..."""
|
---|
| 3244 | ^MAGD(2006.79,29,1,343,0)=" D LOAD^XUMF(4)"
|
---|
| 3245 | ^MAGD(2006.79,29,1,344,0)=" ;"
|
---|
| 3246 | ^MAGD(2006.79,29,1,345,0)=" Q"
|
---|
| 3247 | ^MAGD(2006.79,29,1,346,0)=" ;"
|
---|
| 3248 | ^MAGD(2006.79,29,1,347,0)="SCN(IEN,XUMF) ; screen out HCS entries"
|
---|
| 3249 | ^MAGD(2006.79,29,1,348,0)=" ;"
|
---|
| 3250 | ^MAGD(2006.79,29,1,349,0)=" ; IEN = Institution Internal Entry Number to check"
|
---|
| 3251 | ^MAGD(2006.79,29,1,350,0)=" ;"
|
---|
| 3252 | ^MAGD(2006.79,29,1,351,0)=" S XUMF=$G(XUMF) Q:XUMF 1"
|
---|
| 3253 | ^MAGD(2006.79,29,1,352,0)=" ;"
|
---|
| 3254 | ^MAGD(2006.79,29,1,353,0)=" I $O(^DIC(4.1,""B"",""HCS"",0))=+$G(^DIC(4,+IEN,3)) Q 0"
|
---|
| 3255 | ^MAGD(2006.79,29,1,354,0)=" ;"
|
---|
| 3256 | ^MAGD(2006.79,29,1,355,0)=" Q 1"
|
---|
| 3257 | ^MAGD(2006.79,29,1,356,0)=" ;"
|
---|
| 3258 | ^MAGD(2006.79,30,0)="XUSRB1^3060410.105553"
|
---|
| 3259 | ^MAGD(2006.79,30,1,0)="^2006.791^66^66"
|
---|
| 3260 | ^MAGD(2006.79,30,1,1,0)="XUSRB1 ;iscSF/RWF - More Request Broker ;6/8/04 16:41"
|
---|
| 3261 | ^MAGD(2006.79,30,1,2,0)=" ;;8.0;KERNEL;**28,82,135,275**;Jul 10, 1995"
|
---|
| 3262 | ^MAGD(2006.79,30,1,3,0)=" Q ;No entry from top"
|
---|
| 3263 | ^MAGD(2006.79,30,1,4,0)=" ;"
|
---|
| 3264 | ^MAGD(2006.79,30,1,5,0)="DECRYP(S) ;decrypt passed string"
|
---|
| 3265 | ^MAGD(2006.79,30,1,6,0)=" ;VYD 5/19/95"
|
---|
| 3266 | ^MAGD(2006.79,30,1,7,0)=" N ASSOCIX,IDIX,ASSOCSTR,IDSTR"
|
---|
| 3267 | ^MAGD(2006.79,30,1,8,0)=" Q:$L(S)'>2 """" ;Bad call"
|
---|
| 3268 | ^MAGD(2006.79,30,1,9,0)=" S ASSOCIX=$A($E(S,$L(S)))-31 ;get associator string index"
|
---|
| 3269 | ^MAGD(2006.79,30,1,10,0)=" S IDIX=$A($E(S))-31 ;get identifier string index"
|
---|
| 3270 | ^MAGD(2006.79,30,1,11,0)=" S ASSOCSTR=$P($T(Z+ASSOCIX),"";"",3,9) ;get associator string"
|
---|
| 3271 | ^MAGD(2006.79,30,1,12,0)=" S IDSTR=$P($T(Z+IDIX),"";"",3,9) ;get identifier string"
|
---|
| 3272 | ^MAGD(2006.79,30,1,13,0)=" Q $TR($E(S,2,$L(S)-1),ASSOCSTR,IDSTR) ;translated result"
|
---|
| 3273 | ^MAGD(2006.79,30,1,14,0)=" ;"
|
---|
| 3274 | ^MAGD(2006.79,30,1,15,0)="ENCRYP(S) ;RWF 2/5/96"
|
---|
| 3275 | ^MAGD(2006.79,30,1,16,0)=" N %,ASSOCIX,IDIX,ASSOCSTR,IDSTR"
|
---|
| 3276 | ^MAGD(2006.79,30,1,17,0)=" S ASSOCIX=$R(20)+1 ;get associator index"
|
---|
| 3277 | ^MAGD(2006.79,30,1,18,0)=" F S IDIX=$R(20)+1 Q:ASSOCIX'=IDIX ;get different identifier index"
|
---|
| 3278 | ^MAGD(2006.79,30,1,19,0)=" S ASSOCSTR=$P($T(Z+ASSOCIX),"";"",3,9) ;get associator string"
|
---|
| 3279 | ^MAGD(2006.79,30,1,20,0)=" S IDSTR=$P($T(Z+IDIX),"";"",3,9) ;get identifier string"
|
---|
| 3280 | ^MAGD(2006.79,30,1,21,0)=" ;translated result"
|
---|
| 3281 | ^MAGD(2006.79,30,1,22,0)=" Q $C(IDIX+31)_$TR(S,IDSTR,ASSOCSTR)_$C(ASSOCIX+31)"
|
---|
| 3282 | ^MAGD(2006.79,30,1,23,0)=" ;"
|
---|
| 3283 | ^MAGD(2006.79,30,1,24,0)="SENDKEYS(RESULT) ;send encryption keys to the client"
|
---|
| 3284 | ^MAGD(2006.79,30,1,25,0)=" ;VYD 5/19/95"
|
---|
| 3285 | ^MAGD(2006.79,30,1,26,0)=" N %,X"
|
---|
| 3286 | ^MAGD(2006.79,30,1,27,0)=" S %=1"
|
---|
| 3287 | ^MAGD(2006.79,30,1,28,0)=" F S X=$P($T(Z+%),"";"",3,9) Q:X="""" S RESULT(%)=X,%=%+1"
|
---|
| 3288 | ^MAGD(2006.79,30,1,29,0)=" Q"
|
---|
| 3289 | ^MAGD(2006.79,30,1,30,0)=" ;"
|
---|
| 3290 | ^MAGD(2006.79,30,1,31,0)="BLDDRUM Q ;don't run this tag"
|
---|
| 3291 | ^MAGD(2006.79,30,1,32,0)=" N I,%,ALLCHARS,RNDMSTR,CHAR"
|
---|
| 3292 | ^MAGD(2006.79,30,1,33,0)=" X ""ZP Z"" ;position insertion point"
|
---|
| 3293 | ^MAGD(2006.79,30,1,34,0)=" F I=1:1:20 D"
|
---|
| 3294 | ^MAGD(2006.79,30,1,35,0)=" . S ALLCHARS="""" F %=32:1:126 S:$C(%)'=""^"" ALLCHARS=ALLCHARS_$C(%)"
|
---|
| 3295 | ^MAGD(2006.79,30,1,36,0)=" . S RNDMSTR="""""
|
---|
| 3296 | ^MAGD(2006.79,30,1,37,0)=" . F %=1:1:94 D"
|
---|
| 3297 | ^MAGD(2006.79,30,1,38,0)=" . . S POS=$R($L(ALLCHARS))+1,CHAR=$E(ALLCHARS,POS)"
|
---|
| 3298 | ^MAGD(2006.79,30,1,39,0)=" . . S RNDMSTR=RNDMSTR_CHAR"
|
---|
| 3299 | ^MAGD(2006.79,30,1,40,0)=" . . S ALLCHARS=$P(ALLCHARS,CHAR,1)_$P(ALLCHARS,CHAR,2) ;compress by 1"
|
---|
| 3300 | ^MAGD(2006.79,30,1,41,0)=" . X ""ZI """" ;;""""_RNDMSTR"" ;save random string in routine"
|
---|
| 3301 | ^MAGD(2006.79,30,1,42,0)=" X ""ZS"" ;save routine"
|
---|
| 3302 | ^MAGD(2006.79,30,1,43,0)=" Q"
|
---|
| 3303 | ^MAGD(2006.79,30,1,44,0)=" ;"
|
---|
| 3304 | ^MAGD(2006.79,30,1,45,0)=" ;"
|
---|
| 3305 | ^MAGD(2006.79,30,1,46,0)="Z ;;"
|
---|
| 3306 | ^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"
|
---|
| 3307 | ^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"
|
---|
| 3308 | ^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."
|
---|
| 3309 | ^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!"
|
---|
| 3310 | ^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="
|
---|
| 3311 | ^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"
|
---|
| 3312 | ^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*<"
|
---|
| 3313 | ^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"
|
---|
| 3314 | ^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&"
|
---|
| 3315 | ^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{"
|
---|
| 3316 | ^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 (?%"
|
---|
| 3317 | ^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"
|
---|
| 3318 | ^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"
|
---|
| 3319 | ^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"
|
---|
| 3320 | ^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}"
|
---|
| 3321 | ^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"
|
---|
| 3322 | ^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+"
|
---|
| 3323 | ^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"
|
---|
| 3324 | ^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"
|
---|
| 3325 | ^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!#"
|
---|
| 3326 | ^MAGD(2006.79,"B","MCUIMAG0",1)=""
|
---|
| 3327 | ^MAGD(2006.79,"B","RARIC",2)=""
|
---|
| 3328 | ^MAGD(2006.79,"B","RARTE2",3)=""
|
---|
| 3329 | ^MAGD(2006.79,"B","RAUTL",4)=""
|
---|
| 3330 | ^MAGD(2006.79,"B","RAUTL1",5)=""
|
---|
| 3331 | ^MAGD(2006.79,"B","RAUTL2",6)=""
|
---|
| 3332 | ^MAGD(2006.79,"B","RAUTL20",7)=""
|
---|
| 3333 | ^MAGD(2006.79,"B","RAUTL3",8)=""
|
---|
| 3334 | ^MAGD(2006.79,"B","RAUTL5",9)=""
|
---|
| 3335 | ^MAGD(2006.79,"B","RAXREF",10)=""
|
---|
| 3336 | ^MAGD(2006.79,"B","TIULC1",11)=""
|
---|
| 3337 | ^MAGD(2006.79,"B","TIULS",12)=""
|
---|
| 3338 | ^MAGD(2006.79,"B","TIUSRVPL",13)=""
|
---|
| 3339 | ^MAGD(2006.79,"B","VADPT",14)=""
|
---|
| 3340 | ^MAGD(2006.79,"B","VADPT0",15)=""
|
---|
| 3341 | ^MAGD(2006.79,"B","VADPT1",16)=""
|
---|
| 3342 | ^MAGD(2006.79,"B","VADPT2",17)=""
|
---|
| 3343 | ^MAGD(2006.79,"B","VADPT3",18)=""
|
---|
| 3344 | ^MAGD(2006.79,"B","VADPT30",19)=""
|
---|
| 3345 | ^MAGD(2006.79,"B","VADPT31",20)=""
|
---|
| 3346 | ^MAGD(2006.79,"B","VADPT32",21)=""
|
---|
| 3347 | ^MAGD(2006.79,"B","VADPT4",22)=""
|
---|
| 3348 | ^MAGD(2006.79,"B","VADPT5",23)=""
|
---|
| 3349 | ^MAGD(2006.79,"B","VADPT6",24)=""
|
---|
| 3350 | ^MAGD(2006.79,"B","VADPT60",25)=""
|
---|
| 3351 | ^MAGD(2006.79,"B","VADPT61",26)=""
|
---|
| 3352 | ^MAGD(2006.79,"B","VADPT62",27)=""
|
---|
| 3353 | ^MAGD(2006.79,"B","XLFDT",28)=""
|
---|
| 3354 | ^MAGD(2006.79,"B","XUMF333",29)=""
|
---|
| 3355 | ^MAGD(2006.79,"B","XUSRB1",30)=""
|
---|