- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADD3.m
r613 r623 1 RADD3 ;HISC/SWM-Radiology Data Dictionary Utility Routine ;9/11/97 16:23 2 ;;5.0;Radiology/Nuclear Medicine;**18,65**;Mar 16, 1998;Build 8 3 ; 4 ;Supported IA #2056 reference to GET1^DIQ 5 ;Supported IA #10142 reference to EN^DDIOL 6 ;Supported IA #2053 reference to UPDATE^DIE, FILE^DIE 7 ;Supported IA #10103 reference to NOW^XLFDT 8 ; 9 PAIR ; 10 ; called from file 71.9's field SOURCE 11 ; SOURCE may be added normally via the "RA NM EDIT LOT" option, 12 ; or it may be added via one of the 3 exam edits when the LOT 13 ; prompt appears for the case's Radiopharm. This LOT prompt 14 ; allows adding new LOT on-the-fly, which causes the LOT's 15 ; associated SOURCE, EXPIRATION DATE, KIT # to be prompted 16 ; and the current case's Radiopharm to be stuffed into the new LOT's 17 ; Radiopharm field. The SOURCE field invokes this subroutine to: 18 ; re-set DR string to stuff matching radiopharm 19 ; not allow spacebar return for radioph 20 ; RA*5*65 removed the Fileman Identifier for file 79.1's RADIOPHARM 21 ; so by default, the DR will just be "2;3;4;" without the "5;". 22 ; 23 N RA1,RA2,RA3 24 I $D(RAOPT("EDITPT"))!($D(RAOPT("EDITCN")))!($D(RAOPT("STATRACK"))) D 25 . S RA1=$$EN1^RAPSAPI(RAPSDRUG,.01) 26 . I $G(DR)'[";5",$G(DIE)="^RAMIS(71.9,",+$G(RAPSDRUG),RA1]"" S DR=DR_"5///"_RA1 K ^DISV(DUZ,"^RAMIS(71.9,") 27 . Q 28 ; check pairing of number/id with source 29 ; called by input transform of file 71.9'S field 2 (source) 30 S (RA1,RA2,RA3)="" 31 Q:$G(DA)="" Q:$G(D)="" 32 F S RA1=$O(^RAMIS(71.9,"B",$P(D,U),RA1)) Q:'RA1 I DA'=RA1 S:$P(^RAMIS(71.9,RA1,0),U,2)=+Y RA2=1 ;found a match so set ra2=1 33 W:RA2 !!,"** There's already a NUMBER/ID=",$P(D,U)," and SOURCE=",$P(Y,U,2)," **",! 34 K:RA2 X 35 Q 36 SCRLOT() ;screen lot # from file 70.2 37 ;lot's exp. dt must be within d/t dose admin, if no admin, use exam dt 38 ; if lot's exp. dt is null, allow as choice (don't check) 39 ;lot's radiopharm must match exam's radiopharm 40 ; if lot's radiopharm is null, don't allow as choice 41 ;Y pointer to lot file 42 ;RA0A date/time dose administered 43 ;RA0E date/time exam 44 ;RALOTEXP lot's expiration date 45 ;RA0RAD exam's radiopharmaceutical 46 ;RALOTRAD lot's radiopharmaceutical 47 ;RARETUR return value of screen, 0=failed, 1=passed 48 I '$D(Y)#2!('$D(DA))!('$D(DA(1))) Q 0 49 N RA0A,RA0E,RALOTEXP,RA0RAD,RALOTRAD,RARETURN 50 S RARETURN=0 51 S RA0E=$P(^RADPTN(DA(1),0),U,2),RA0A=$P(^("NUC",DA,0),U,8),RA0RAD=$P(^(0),U),RALOTEXP=$P(^RAMIS(71.9,+Y,0),U,3),RALOTRAD=$P(^(0),U,5) 52 I $S(RALOTEXP="":1,RA0A:RALOTEXP>RA0A,1:RALOTEXP>RA0E),(RA0RAD=RALOTRAD) S RARETURN=1 53 Q RARETURN 54 ; 55 GETID(Y) ; Pass back a string of data which will be used as an 56 ; identifier when lookups are done on the Imaging Locations (79.1) file 57 ; Input : Y -> ien of entry in 79.1 58 ; Output: string of data relevent to the entry in file 79.1 59 ; Location I-type_"-"_Station # of Rad/Nuc Med Division 60 N RA791 S RA791(0)=$G(^RA(79.1,Y,0)) 61 S RA791("DIV")=$G(^RA(79.1,Y,"DIV")) 62 Q "("_$$GET1^DIQ(79.2,+$P(RA791(0),"^",6),.01)_"-"_$$GET1^DIQ(4,+$P(RA791("DIV"),"^"),99)_")" 63 ; 64 DELDESC(RAIEN) ; This sub-routine will determine if descendents can be 65 ; deleted from parent procedures. If only one descendent exists, and 66 ; the parent is on the common procedure list do not allow the deletion 67 ; of the descendent. 68 ; Input : RAIEN (the DA array for the Rad/Nuc Med Procedure file.) 69 ; Output: 0 if ok to delete, 1 if not ok to delete 70 ; Called from: ^DD(71.05,.01,"DEL",1,0) node 71 N I,RA713,RATTL S (I,RA713,RATTL)=0 72 S:$D(^RAMIS(71.3,"B",RAIEN(1))) RA713=+$O(^RAMIS(71.3,"B",RAIEN(1),0)) 73 S:RA713>0 RA713(0)=$G(^RAMIS(71.3,RA713,0)) 74 F S I=$O(^RAMIS(71,RAIEN(1),4,I)) Q:I'>0 S RATTL=RATTL+1 75 I RA713,($P(RA713(0),"^",5)=""),(RATTL=1) D Q 1 76 . ; don't allow deletion of the last descendent on procedures that are 77 . ; currently active in the common procedure file. 78 . N RATXT S RATXT(1)=" " 79 . S RATXT(2)="You cannot delete the last or only descendent from a" 80 . S RATXT(3)="parent procedure when the parent procedure is an active" 81 . S RATXT(4)="common procedure.",RATXT(5)=$C(7) D EN^DDIOL(.RATXT) 82 . Q 83 Q 0 ; common procedure with more than one descendent, ok to delete 84 ; 85 REACMMN(RADA) ; Check to see if a commom procedure can be re-activated. 86 ; This sub-routine checks if this common is a parent w/o descendents. 87 ; If true, this common procedure cannot be re-activated. 88 ; Input : RADA - ien of the entry in 71.3 89 ; Output: 0 if ok to delete, 1 if not ok to delete 90 ; Called from ^DD(71.3,4,"DEL",1,0) 91 N RA713 S RA713=$G(^RAMIS(71.3,RADA,0)) 92 I $P($G(^RAMIS(71,+RA713,0)),"^",6)="P",('$O(^RAMIS(71,+RA713,4,0))) D Q 1 93 . N RATXT S RATXT(1)=" " 94 . S RATXT(2)="You cannot re-activate a common parent procedure without descendents." 95 . S RATXT(3)=$C(7) D EN^DDIOL(.RATXT) 96 . Q 97 Q 0 ; ok to delete 98 ; 99 X7005(RADFN,RADTI,RACNI,RAMDV,RAQED,RASTI,RAWHO) ;update the EXAM 100 ; STATUS TIMES (70.05) multiple. Called from RASTED (will be 101 ; called from RAUTL1 in the future) 102 ; 103 ; input variables: 104 ; ---------------- 105 ; RADFN=patient dfn, RADTI=exam date/time (inverse) 106 ; RACNI=exam record ien (70.03), RAMDV=division parameters 107 ; RAQED=task queued(1=yes;0=no), RASTI=exam status 108 ; RAWHO=editing person 109 ; 110 N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y 111 S RAQED=+$G(RAQED) ; if tasked 1, else 0 112 S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 113 S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) 114 D UPDATE^DIE(,"RAFDA","RAIEN") ; RAIEN(1)=ien of new record 115 K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added 116 I $P(RAMDV,"^",11),('RAQED) D 117 .S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","_RACNI_",""T""," 118 .S DA=RAIEN(1),DR=".01" D ^DIE 119 S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 120 S RAFDA(70.05,RAIENS,2)=RASTI 121 S RAFDA(70.05,RAIENS,3)=$G(RAWHO) 122 D FILE^DIE(,"RAFDA") 123 Q 124 A7007(RADFN,RADTI,RACNI,RAWHO,RATC) ; update the ACTIVITY LOG (70.07) 125 ; multiple. Called from RASTED (will be called from RAUTL1 in the 126 ; future) 127 ; 128 ; input variables: 129 ; ---------------- 130 ; RADFN=patient dfn, RADTI=exam date/time (inverse) 131 ; RACNI=exam record ien (70.03), RAWHO=editing person 132 ; RATC=technologist comments (optional) 133 ; 134 N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y 135 S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 136 S RAFDA(70.07,RAIENS,.01)="NOW" 137 D UPDATE^DIE("E","RAFDA","RAIEN") ;RAIEN(1)=ien of new record 138 K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added 139 S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 140 S RAFDA(70.07,RAIENS,2)="U" 141 S RAFDA(70.07,RAIENS,3)=$G(RAWHO) 142 S:$G(RATC)]"" RAFDA(70.07,RAIENS,4)=RATC 143 D FILE^DIE(,"RAFDA") 144 Q 145 ; 146 ;updates EXAM STATUS 147 U70033(RA18DFN,RA18DTI,RA18CNI,RA18ST) ; 148 N %,D,D0,DA,DIC,DIE,DQ,DR,RA18FDA,RA18IENS,X,Y 149 S RA18IENS=RA18CNI_","_RA18DTI_","_RA18DFN_"," 150 S RA18FDA(70.03,RA18IENS,3)=RA18ST 151 D FILE^DIE(,"RA18FDA") 152 Q 153 ; 1 RADD3 ;HISC/SWM-Radiology Data Dictionary Utility Routine ;9/11/97 16:23 2 ;;5.0;Radiology/Nuclear Medicine;**18**;Mar 16, 1998 3 PAIR ; 4 ; if editing SOURCE for new (laygo) LOT entry in file 71.9 5 ; then re-set DR string to stuff matching radiopharm 6 ; and don't allow spacebar return for radioph 7 I $D(RAOPT("EDITPT"))!($D(RAOPT("EDITCN")))!($D(RAOPT("STATRACK"))) D 8 . I $G(DR)[";5",$G(DIE)="^RAMIS(71.9,",+$G(RAPSDRUG),$P($G(^PSDRUG(+$G(RAPSDRUG),0)),U)]"" S DR=$P(DR,";5")_";5///"_$P($G(^PSDRUG(+$G(RAPSDRUG),0)),U)_$P(DR,";5",2,99) K ^DISV(DUZ,"^RAMIS(71.9,") 9 . Q 10 ; check pairing of number/id with source 11 ; called by input transform of file 71.9'S field 2 (source) 12 N RA1,RA2,RA3 S (RA1,RA2,RA3)="" 13 Q:$G(DA)="" Q:$G(D)="" 14 F S RA1=$O(^RAMIS(71.9,"B",$P(D,U),RA1)) Q:'RA1 I DA'=RA1 S:$P(^RAMIS(71.9,RA1,0),U,2)=+Y RA2=1 ;found a match so set ra2=1 15 W:RA2 !!,"** There's already a NUMBER/ID=",$P(D,U)," and SOURCE=",$P(Y,U,2)," **",! 16 K:RA2 X 17 Q 18 SCRLOT() ;screen lot # from file 70.2 19 ;lot's exp. dt must be within d/t dose admin, if no admin, use exam dt 20 ; if lot's exp. dt is null, allow as choice (don't check) 21 ;lot's radiopharm must match exam's radiopharm 22 ; if lot's radiopharm is null, don't allow as choice 23 ;Y pointer to lot file 24 ;RA0A date/time dose administered 25 ;RA0E date/time exam 26 ;RALOTEXP lot's expiration date 27 ;RA0RAD exam's radiopharmaceutical 28 ;RALOTRAD lot's radiopharmaceutical 29 ;RARETUR return value of screen, 0=failed, 1=passed 30 I '$D(Y)#2!('$D(DA))!('$D(DA(1))) Q 0 31 N RA0A,RA0E,RALOTEXP,RA0RAD,RALOTRAD,RARETURN 32 S RARETURN=0 33 S RA0E=$P(^RADPTN(DA(1),0),U,2),RA0A=$P(^("NUC",DA,0),U,8),RA0RAD=$P(^(0),U),RALOTEXP=$P(^RAMIS(71.9,+Y,0),U,3),RALOTRAD=$P(^(0),U,5) 34 I $S(RALOTEXP="":1,RA0A:RALOTEXP>RA0A,1:RALOTEXP>RA0E),(RA0RAD=RALOTRAD) S RARETURN=1 35 Q RARETURN 36 ; 37 GETID(Y) ; Pass back a string of data which will be used as an 38 ; identifier when lookups are done on the Imaging Locations (79.1) file 39 ; Input : Y -> ien of entry in 79.1 40 ; Output: string of data relevent to the entry in file 79.1 41 ; Location I-type_"-"_Station # of Rad/Nuc Med Division 42 N RA791 S RA791(0)=$G(^RA(79.1,Y,0)) 43 S RA791("DIV")=$G(^RA(79.1,Y,"DIV")) 44 Q "("_$$GET1^DIQ(79.2,+$P(RA791(0),"^",6),.01)_"-"_$$GET1^DIQ(4,+$P(RA791("DIV"),"^"),99)_")" 45 ; 46 DELDESC(RAIEN) ; This sub-routine will determine if descendents can be 47 ; deleted from parent procedures. If only one descendent exists, and 48 ; the parent is on the common procedure list do not allow the deletion 49 ; of the descendent. 50 ; Input : RAIEN (the DA array for the Rad/Nuc Med Procedure file.) 51 ; Output: 0 if ok to delete, 1 if not ok to delete 52 ; Called from: ^DD(71.05,.01,"DEL",1,0) node 53 N I,RA713,RATTL S (I,RA713,RATTL)=0 54 S:$D(^RAMIS(71.3,"B",RAIEN(1))) RA713=+$O(^RAMIS(71.3,"B",RAIEN(1),0)) 55 S:RA713>0 RA713(0)=$G(^RAMIS(71.3,RA713,0)) 56 F S I=$O(^RAMIS(71,RAIEN(1),4,I)) Q:I'>0 S RATTL=RATTL+1 57 I RA713,($P(RA713(0),"^",5)=""),(RATTL=1) D Q 1 58 . ; don't allow deletion of the last descendent on procedures that are 59 . ; currently active in the common procedure file. 60 . N RATXT S RATXT(1)=" " 61 . S RATXT(2)="You cannot delete the last or only descendent from a" 62 . S RATXT(3)="parent procedure when the parent procedure is an active" 63 . S RATXT(4)="common procedure.",RATXT(5)=$C(7) D EN^DDIOL(.RATXT) 64 . Q 65 Q 0 ; common procedure with more than one descendent, ok to delete 66 ; 67 REACMMN(RADA) ; Check to see if a commom procedure can be re-activated. 68 ; This sub-routine checks if this common is a parent w/o descendents. 69 ; If true, this common procedure cannot be re-activated. 70 ; Input : RADA - ien of the entry in 71.3 71 ; Output: 0 if ok to delete, 1 if not ok to delete 72 ; Called from ^DD(71.3,4,"DEL",1,0) 73 N RA713 S RA713=$G(^RAMIS(71.3,RADA,0)) 74 I $P($G(^RAMIS(71,+RA713,0)),"^",6)="P",('$O(^RAMIS(71,+RA713,4,0))) D Q 1 75 . N RATXT S RATXT(1)=" " 76 . S RATXT(2)="You cannot re-activate a common parent procedure without descendents." 77 . S RATXT(3)=$C(7) D EN^DDIOL(.RATXT) 78 . Q 79 Q 0 ; ok to delete 80 ; 81 X7005(RADFN,RADTI,RACNI,RAMDV,RAQED,RASTI,RAWHO) ;update the EXAM 82 ; STATUS TIMES (70.05) multiple. Called from RASTED (will be 83 ; called from RAUTL1 in the future) 84 ; 85 ; input variables: 86 ; ---------------- 87 ; RADFN=patient dfn, RADTI=exam date/time (inverse) 88 ; RACNI=exam record ien (70.03), RAMDV=division parameters 89 ; RAQED=task queued(1=yes;0=no), RASTI=exam status 90 ; RAWHO=editing person 91 ; 92 N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y 93 S RAQED=+$G(RAQED) ; if tasked 1, else 0 94 S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 95 S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) 96 D UPDATE^DIE(,"RAFDA","RAIEN") ; RAIEN(1)=ien of new record 97 K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added 98 I $P(RAMDV,"^",11),('RAQED) D 99 .S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","_RACNI_",""T""," 100 .S DA=RAIEN(1),DR=".01" D ^DIE 101 S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 102 S RAFDA(70.05,RAIENS,2)=RASTI 103 S RAFDA(70.05,RAIENS,3)=$G(RAWHO) 104 D FILE^DIE(,"RAFDA") 105 Q 106 A7007(RADFN,RADTI,RACNI,RAWHO,RATC) ; update the ACTIVITY LOG (70.07) 107 ; multiple. Called from RASTED (will be called from RAUTL1 in the 108 ; future) 109 ; 110 ; input variables: 111 ; ---------------- 112 ; RADFN=patient dfn, RADTI=exam date/time (inverse) 113 ; RACNI=exam record ien (70.03), RAWHO=editing person 114 ; RATC=technologist comments (optional) 115 ; 116 N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y 117 S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 118 S RAFDA(70.07,RAIENS,.01)="NOW" 119 D UPDATE^DIE("E","RAFDA","RAIEN") ;RAIEN(1)=ien of new record 120 K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added 121 S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 122 S RAFDA(70.07,RAIENS,2)="U" 123 S RAFDA(70.07,RAIENS,3)=$G(RAWHO) 124 S:$G(RATC)]"" RAFDA(70.07,RAIENS,4)=RATC 125 D FILE^DIE(,"RAFDA") 126 Q 127 ; 128 ;updates EXAM STATUS 129 U70033(RA18DFN,RA18DTI,RA18CNI,RA18ST) ; 130 N %,D,D0,DA,DIC,DIE,DQ,DR,RA18FDA,RA18IENS,X,Y 131 S RA18IENS=RA18CNI_","_RA18DTI_","_RA18DFN_"," 132 S RA18FDA(70.03,RA18IENS,3)=RA18ST 133 D FILE^DIE(,"RA18FDA") 134 Q 135 ;
Note:
See TracChangeset
for help on using the changeset viewer.
