- 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/RAMAIN2.m
r613 r623 1 RAMAIN2 ;HISC/GJC-Radiology Utility File Maintenance (Part Two) ;8/15/05 10:07am 2 ;;5.0;Radiology/Nuclear Medicine;**45,62,71,65**;Mar 16, 1998;Build 8 3 ; 08/12/2005 bay/kam Remedy Call 104630 Patch 62 4 ; 03/02/2006 BAY/KAM Remedy Call 131482 Patch RA*5*71 5 ; 6 ;Supported IA #10141 reference to MES^XPDUTL 7 ;Supported IA #10142 reference to EN^DDIOL 8 ;Supported IA #10103 reference to DT^XLFDT 9 ; 10 2 ;;Procedure Enter/Edit 11 ; *** This subroutine once resided in RAMAIN i.e, '2^RAMAIN'. *** 12 ; RA PROCEDURE option 13 N RACTIVE,RAENALL,RAY,RAFILE,RASTAT,RAXIT 14 S (RAENALL,RANEW71,RAXIT)=0 15 N RADIO,RAPTY,RAASK,RAROUTE ;used by the edit template 16 F D Q:$G(RAXIT) 17 . K DA,DD,DIC,DINUM,DLAYGO,DO,RACMDIFF,RATRKCMA,RATRKCMB 18 . S DIC="^RAMIS(71,",DIC(0)="QEAMLZ",DLAYGO=71,DIC("DR")=6 19 . W ! D ^DIC K D,DD,DIC,DINUM,DLAYGO,DO 20 . S:+Y<0 RAXIT=1 I $G(RAXIT) K D,X,Y Q 21 . S (DA,RADA)=+Y,RAY=Y,RAFILE=71 22 . ;RA*5*71 changed next line for Remedy Call 131482 23 . S RANEW71=$S($P(Y,U,3)=1:1,1:0) ;used in template, edit CPT Code if new rec. 24 . L +^RAMIS(RAFILE,RADA):5 25 . I '$T D Q 26 .. W !?5,"This record is currently being edited by another user." 27 .. W !?5,"Try again later!",$C(7) S RAXIT=1 28 .. Q 29 . S RAPNM=$P($G(Y(0)),U) ;proc. name for display purposes in template 30 . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") 31 . S RASTAT=$S(RACTIVE="":1,RACTIVE>DT:1,1:0) 32 . D TRKCMB^RAMAINU(DA,.RATRKCMB) ;tracks existing 33 . ; CM definition before editing. RATRKCMB ids the before CM values 34 . S DIE="^RAMIS(71,",DR="[RA PROCEDURE EDIT]" D ^DIE 35 . K RAPNM S RAPROC(0)=$G(^RAMIS(71,RADA,0)) 36 . ; 37 . ;check for data consistency between the 'CONTRAST MEDIA USED' & 38 . ;'CONTRAST MEDIA' fields. 39 . D CMINTEG^RAMAINU1(RADA,RAPROC(0)) 40 . ; 41 . D TRKCMA^RAMAINU(RADA,RATRKCMB,.RATRKCMA,.RACMDIFF) 42 . I $O(^RAMIS(71,RADA,"NUC",0)),($P(RAPROC(0),"^",2)=1) D DELRADE(RADA) 43 . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") 44 . S RASTAT=RASTAT_"^"_$S(RACTIVE="":1,RACTIVE>DT:1,1:0) 45 . ; 08/12/2005 104630 KAM - added '$G(RANEW71) to next line 46 . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),'+$G(RANEW71) D 47 .. K %,C,D0,DE,DI,DIE,DQ,DR 48 .. W !?5,$C(7),"...no CPT code entered..." 49 .. W !?5,"...will change type to a 'broad' procedure.",! 50 .. S DA=RADA,DIE="^RAMIS(71,",DR="6///B" D ^DIE 51 .. Q 52 . ;08/12/2005 104630 - KAM added next 5 lines 53 . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),+$G(RANEW71) D 54 .. K %,C,D0,DE,DI,DIK,DQ,DR 55 .. W !?5,$C(7),"...no CPT code entered..." 56 .. W !?5,"...will delete the record at this time.",! 57 .. S DIK="^RAMIS(71,",DA=RADA D ^DIK K DIK 58 . ;if an active parent w/o descendants, inactivate the parent 59 . I $P(RASTAT,U,2),($P(RAPROC(0),U,6)="P"),('$O(^RAMIS(71,RADA,4,0))) D 60 .. K D,D0,D1,DA,DI,DIC,DIE,DQ,DR 61 .. W !!?5,"Inactivating this parent procedure - no descendents.",!,$C(7) 62 .. S DA=RADA,DIE="^RAMIS(71,",DR="100///"_$S($D(DT):DT,1:$$DT^XLFDT()) 63 .. D ^DIE K D,D0,D1,DA,DI,DIC,DIE,DQ,DR S $P(RASTAT,U,2)=0 ;inactive 64 .. Q 65 . I $P($G(^RA(79.2,+$P(RAPROC(0),U,12),0)),U,5)="Y",(+$O(^RAMIS(71,RADA,"NUC",0))) D VRDIO(RADA) 66 . I "^B^P^"[(U_$P(RAPROC(0),U,6)_U),($P(RAPROC(0),U,9)]"") D 67 .. K %,D,D0,DA,DE,DIC,DIE,DQ,DR 68 .. S DA=RADA,DIE="^RAMIS(71,",DR="9///@" D ^DIE 69 .. W !!?5,"...CPT code deleted because "_$S($P(RAPROC(0),U,6)="B":"Broad",1:"Parent")_" procedures",!?5,"should not have CPT codes.",!,$C(7) 70 .. Q 71 . K %,%X,%Y,C,D,D0,D1,DA,DE,DI,DIE,DQ,DR,RAIMAG,RAMIS,RAPROC,X,Y 72 .;send Orderable Item HL7 msg to CPRS if the ORDER DIALOG (#101.41) 73 .;file exists unconditionally 74 .D:$$ORQUIK^RAORDU()=1 PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 75 .; 76 . L -^RAMIS(RAFILE,RADA) K RADA 77 .;unconditionally update the parent procedure if the descendent 78 .I $O(^RAMIS(71,"ADESC",+RAY,0)) D UPDATP^RAO7UTL(RAY) 79 .;has been edited 80 . Q 81 K DIR,RACMDIFF,RATRKCMA,RATRKCMB 82 S DIR(0)="YA",DIR("B")="NO" 83 S DIR("A")="Want to run a validity check on CPT and stop codes? " 84 S DIR("?",1)="Answer 'YES' to print a list of Radiology/Nuclear Medicine Procedures" 85 S DIR("?",2)="with missing or invalid CPT's and/or Credit Clinic Stop Code(s)." 86 S DIR("?",3)="Broad procedures with invalid codes are included for information" 87 S DIR("?",4)="only. Inactive procedures are not required to have valid codes." 88 S DIR("?",5)="To be valid, Stop Codes must be in the Imaging Stop Codes file 71.5;" 89 S DIR("?",6)="CPT's must be nationally active." 90 S DIR("?")="Please answer 'YES' or 'NO'." 91 W ! D ^DIR K DIR G:$D(DIRUT) EXIT 92 D:Y ^RAPERR 93 EXIT K RADA,RANEW71,X,Y 94 Q 95 13 ;;Rad/Nuc Med Common Procedure File Enter/Edit 96 ; RA COMMON PROCEDURE option 97 N RADA,RAENALL,RAY,RAFILE,RALOW,RAMIS713,RASTAT,RAIMGTYI S RAENALL=0 98 W ! D EN1^RAUTL17 G:Y'>0 Q13 S RAIMGTYI=Y 99 131 S DIC="^RAMIS(71.3,",DIC(0)="AELMQZ",DLAYGO=71.3 100 S DIC("S")="N RA S RA=+$P(^(0),U) I RAIMGTYI=$P($G(^RAMIS(71,RA,0)),U,12)" 101 S DIC("W")="N RA4 S RA4=$P($G(^(0)),""^"",4) W:RA4]"""" "" (""_RA4_"")"" W:RA4']"""" "" (no sequence number)""" 102 W ! D ^DIC K DIC,DLAYGO,D,X 103 I Y<0 D Q13 G RESEQ 104 ; If a sequence # exists, the Common Proc. is active 105 S RADA=+Y,RAY=Y,RAFILE=71.3 L +^RAMIS(RAFILE,RADA):5 106 I '$T D G Q13 107 . W !?5,"This record is currently being edited by another user." 108 . W !?5,"Try again later!",$C(7) 109 . Q 110 S RASTAT=$S($P(Y(0),"^",4)]"":1,1:0)_"^" 111 I '+$P(RASTAT,"^") S RALOW=$$LOW(RAIMGTYI) 112 S DA=RADA,DIE="^RAMIS(71.3,",DR="[RA COMMON PROCEDURE EDIT]" D ^DIE 113 S RAMIS713(0)=$G(^RAMIS(71.3,RADA,0)) 114 ; If the procedure is different than the one originally selected and 115 ; the CPRS Order Dialog file exists, send the Orderable Item Update 116 ; message to CPRS. 117 I $P(RAMIS713(0),"^")'=$P(RAY,"^",2),($$ORQUIK^RAORDU()=1) D 118 . S RASTAT=RASTAT_0 D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 119 . S RAY=RADA_"^"_$P($G(^RAMIS(71.3,RADA,0)),"^")_"^"_1,RASTAT=0_"^" 120 . Q 121 K %,%X,%Y,C,D,D0,DA,DE,DI,DIE,DQ,DR,X,Y 122 S RASTAT=RASTAT_$S($P($G(^RAMIS(71.3,+RAY,0)),"^",4)]"":1,1:0) 123 ; If before & after statuses differ, and the CPRS Order Dialog file 124 ; exists, send the Orderable Item Update message to CPRS. 125 I $$ORQUIK^RAORDU()=1,(($P(RASTAT,"^")+$P(RASTAT,"^",2))=1) D 126 . D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 127 . Q 128 L -^RAMIS(RAFILE,RADA) 129 G 131 130 Q13 K DDC,DDH,DISYS,I,POP,RA713 131 Q 132 RESEQ ;Resequence the common procedure list 133 N D,D0,DI,DQ,H,I,J,CNT,DIC,DIE,DR,DA,TXT,X 134 I $D(XPDNM) D ; if called during package install 135 . S TXT(1)=" " 136 . S TXT(2)="Resequencing the Rad/Nuc Med Common Procedure List." 137 . Q 138 E W !!?5,"Resequencing the Rad/Nuc Med Common Procedure List" 139 S DIE="^RAMIS(71.3,",(I,CNT)=0 140 F S I=$O(^RAMIS(71.3,"AA",RAIMGTYI,I)) Q:I'>0 D 141 . S J=0 142 . F S J=$O(^RAMIS(71.3,"AA",RAIMGTYI,I,J)) Q:J'>0 I $D(^RAMIS(71.3,J,0)) D 143 .. S DA=J,CNT=CNT+1 N I,J 144 .. S DR="3////^S X=CNT" D ^DIE W:'$D(XPDNM) "." 145 .. Q 146 . Q 147 I $D(XPDNM) D ; if called during package install 148 . S TXT(2)=$G(TXT(2))_" Done!" 149 . D MES^XPDUTL(.TXT) 150 . Q 151 E W " Done!" 152 Q 153 LOW(X) ; Find the lowest available sequence number for a procedure within 154 ; a specific Imaging Type. Seq. #'s range from 1 to 40. If the 155 ; range changes in the DD i.e, ^DD(71.3,3, this code as well as the 156 ; code if EN3^RAUTL18 must also be altered. 157 ; If RAHIT is passed back as "", there is no available sequence number. 158 N RA,RAHIT S RAHIT="" 159 F RA=1:1:40 D Q:RAHIT 160 . Q:$D(^RAMIS(71.3,"AA",X,RA)) 161 . S:RAHIT="" RAHIT=RA 162 . Q 163 Q RAHIT 164 VRDIO(RADA) ; Validate the 'Usual Dose' field within the 'Default Radiopha- 165 ; rmaceuticals' multiple. 'Usual Dose' must fall within the 'Low Adult 166 ; Dose' & 'High Adult Dose' range. This subroutine will display the 167 ; Radiopharmaceutical in question along with the values in question if 168 ; inconsistencies are found. 169 ; 170 ; Input Variable: 'RADA' the ien of the Procedure 171 N RANUC S RADA(1)=RADA,RADA=0 D EN^DDIOL("","","!") 172 F S RADA=$O(^RAMIS(71,RADA(1),"NUC",RADA)) Q:RADA'>0 D 173 . S RANUC(0)=$G(^RAMIS(71,RADA(1),"NUC",RADA,0)) 174 . Q:$P(RANUC(0),"^",2)="" ; no need to validate, nothing input 175 . I '$$USUAL^RADD2(.RADA,$P(RANUC(0),"^",2)) D 176 .. N RARRY S RARRY(1)="For Radiopharmaceutical: " 177 .. S RARRY(1)=RARRY(1)_$$EN1^RAPSAPI(+$P(RANUC(0),"^"),.01)_$C(7) 178 .. S RARRY(2)="" D EN^DDIOL(.RARRY,"") 179 .. Q 180 . Q 181 Q 182 DELRADE(RADA) ; Delete the Default Radiopharmaceuticals multiple 183 N RADA1 S RADA1=0 184 W !!?3,"Deleting default radiopharmaceuticals for this procedure...",! 185 F S RADA1=$O(^RAMIS(71,RADA,"NUC",RADA1)) Q:RADA1'>0 D 186 . K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 187 . S DA(1)=RADA,DA=RADA1,DIE="^RAMIS(71,"_RADA_",""NUC""," 188 . S DR=".01///@" D ^DIE 189 . Q 190 K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 191 Q 192 ; 1 RAMAIN2 ;HISC/GJC-Radiology Utility File Maintenance (Part Two) ;8/15/05 10:07am 2 ;;5.0;Radiology/Nuclear Medicine;**45,62,71**;Mar 16, 1998;Build 10 3 ; 08/12/2005 bay/kam Remedy Call 104630 Patch 62 4 ; 03/02/2006 BAY/KAM Remedy Call 131482 Patch RA*5*71 5 2 ;;Procedure Enter/Edit 6 ; *** This subroutine once resided in RAMAIN i.e, '2^RAMAIN'. *** 7 ; RA PROCEDURE option 8 N RACTIVE,RAENALL,RAY,RAFILE,RASTAT,RAXIT 9 S (RAENALL,RANEW71,RAXIT)=0 10 N RADIO,RAPTY,RAASK,RAROUTE ;used by the edit template 11 F D Q:$G(RAXIT) 12 . K DA,DD,DIC,DINUM,DLAYGO,DO,RACMDIFF,RATRKCMA,RATRKCMB 13 . S DIC="^RAMIS(71,",DIC(0)="QEAMLZ",DLAYGO=71,DIC("DR")=6 14 . W ! D ^DIC K D,DD,DIC,DINUM,DLAYGO,DO 15 . S:+Y<0 RAXIT=1 I $G(RAXIT) K D,X,Y Q 16 . S (DA,RADA)=+Y,RAY=Y,RAFILE=71 17 . ;RA*5*71 changed next line for Remedy Call 131482 18 . S RANEW71=$S($P(Y,U,3)=1:1,1:0) ;used in template, edit CPT Code if new rec. 19 . L +^RAMIS(RAFILE,RADA):5 20 . I '$T D Q 21 .. W !?5,"This record is currently being edited by another user." 22 .. W !?5,"Try again later!",$C(7) S RAXIT=1 23 .. Q 24 . S RAPNM=$P($G(Y(0)),U) ;proc. name for display purposes in template 25 . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") 26 . S RASTAT=$S(RACTIVE="":1,RACTIVE>DT:1,1:0) 27 . D TRKCMB^RAMAINU(DA,.RATRKCMB) ;tracks existing 28 . ; CM definition before editing. RATRKCMB ids the before CM values 29 . S DIE="^RAMIS(71,",DR="[RA PROCEDURE EDIT]" D ^DIE 30 . K RAPNM S RAPROC(0)=$G(^RAMIS(71,RADA,0)) 31 . ; 32 . ;check for data consistency between the 'CONTRAST MEDIA USED' & 33 . ;'CONTRAST MEDIA' fields. 34 . D CMINTEG^RAMAINU1(RADA,RAPROC(0)) 35 . ; 36 . D TRKCMA^RAMAINU(RADA,RATRKCMB,.RATRKCMA,.RACMDIFF) 37 . I $O(^RAMIS(71,RADA,"NUC",0)),($P(RAPROC(0),"^",2)=1) D DELRADE(RADA) 38 . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") 39 . S RASTAT=RASTAT_"^"_$S(RACTIVE="":1,RACTIVE>DT:1,1:0) 40 . ; 08/12/2005 104630 KAM - added '$G(RANEW71) to next line 41 . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),'+$G(RANEW71) D 42 .. K %,C,D0,DE,DI,DIE,DQ,DR 43 .. W !?5,$C(7),"...no CPT code entered..." 44 .. W !?5,"...will change type to a 'broad' procedure.",! 45 .. S DA=RADA,DIE="^RAMIS(71,",DR="6///B" D ^DIE 46 .. Q 47 . ;08/12/2005 104630 - KAM added next 5 lines 48 . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),+$G(RANEW71) D 49 .. K %,C,D0,DE,DI,DIK,DQ,DR 50 .. W !?5,$C(7),"...no CPT code entered..." 51 .. W !?5,"...will delete the record at this time.",! 52 .. S DIK="^RAMIS(71,",DA=RADA D ^DIK K DIK 53 . ;if an active parent w/o descendants, inactivate the parent 54 . I $P(RASTAT,U,2),($P(RAPROC(0),U,6)="P"),('$O(^RAMIS(71,RADA,4,0))) D 55 .. K D,D0,D1,DA,DI,DIC,DIE,DQ,DR 56 .. W !!?5,"Inactivating this parent procedure - no descendents.",!,$C(7) 57 .. S DA=RADA,DIE="^RAMIS(71,",DR="100///"_$S($D(DT):DT,1:$$DT^XLFDT()) 58 .. D ^DIE K D,D0,D1,DA,DI,DIC,DIE,DQ,DR S $P(RASTAT,U,2)=0 ;inactive 59 .. Q 60 . I $P($G(^RA(79.2,+$P(RAPROC(0),U,12),0)),U,5)="Y",(+$O(^RAMIS(71,RADA,"NUC",0))) D VRDIO(RADA) 61 . I "^B^P^"[(U_$P(RAPROC(0),U,6)_U),($P(RAPROC(0),U,9)]"") D 62 .. K %,D,D0,DA,DE,DIC,DIE,DQ,DR 63 .. S DA=RADA,DIE="^RAMIS(71,",DR="9///@" D ^DIE 64 .. W !!?5,"...CPT code deleted because "_$S($P(RAPROC(0),U,6)="B":"Broad",1:"Parent")_" procedures",!?5,"should not have CPT codes.",!,$C(7) 65 .. Q 66 . K %,%X,%Y,C,D,D0,D1,DA,DE,DI,DIE,DQ,DR,RAIMAG,RAMIS,RAPROC,X,Y 67 .;send Orderable Item HL7 msg to CPRS if the ORDER DIALOG (#101.41) 68 .;file exists unconditionally 69 .D:$$ORQUIK^RAORDU()=1 PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 70 .; 71 . L -^RAMIS(RAFILE,RADA) K RADA 72 .;unconditionally update the parent procedure if the descendent 73 .I $O(^RAMIS(71,"ADESC",+RAY,0)) D UPDATP^RAO7UTL(RAY) 74 .;has been edited 75 . Q 76 K DIR,RACMDIFF,RATRKCMA,RATRKCMB 77 S DIR(0)="YA",DIR("B")="NO" 78 S DIR("A")="Want to run a validity check on CPT and stop codes? " 79 S DIR("?",1)="Answer 'YES' to print a list of Radiology/Nuclear Medicine Procedures" 80 S DIR("?",2)="with missing or invalid CPT's and/or Credit Clinic Stop Code(s)." 81 S DIR("?",3)="Broad procedures with invalid codes are included for information" 82 S DIR("?",4)="only. Inactive procedures are not required to have valid codes." 83 S DIR("?",5)="To be valid, Stop Codes must be in the Imaging Stop Codes file 71.5;" 84 S DIR("?",6)="CPT's must be nationally active." 85 S DIR("?")="Please answer 'YES' or 'NO'." 86 W ! D ^DIR K DIR G:$D(DIRUT) EXIT 87 D:Y ^RAPERR 88 EXIT K RADA,RANEW71,X,Y 89 Q 90 13 ;;Rad/Nuc Med Common Procedure File Enter/Edit 91 ; RA COMMON PROCEDURE option 92 N RADA,RAENALL,RAY,RAFILE,RALOW,RAMIS713,RASTAT,RAIMGTYI S RAENALL=0 93 W ! D EN1^RAUTL17 G:Y'>0 Q13 S RAIMGTYI=Y 94 131 S DIC="^RAMIS(71.3,",DIC(0)="AELMQZ",DLAYGO=71.3 95 S DIC("S")="N RA S RA=+$P(^(0),U) I RAIMGTYI=$P($G(^RAMIS(71,RA,0)),U,12)" 96 S DIC("W")="N RA4 S RA4=$P($G(^(0)),""^"",4) W:RA4]"""" "" (""_RA4_"")"" W:RA4']"""" "" (no sequence number)""" 97 W ! D ^DIC K DIC,DLAYGO,D,X 98 I Y<0 D Q13 G RESEQ 99 ; If a sequence # exists, the Common Proc. is active 100 S RADA=+Y,RAY=Y,RAFILE=71.3 L +^RAMIS(RAFILE,RADA):5 101 I '$T D G Q13 102 . W !?5,"This record is currently being edited by another user." 103 . W !?5,"Try again later!",$C(7) 104 . Q 105 S RASTAT=$S($P(Y(0),"^",4)]"":1,1:0)_"^" 106 I '+$P(RASTAT,"^") S RALOW=$$LOW(RAIMGTYI) 107 S DA=RADA,DIE="^RAMIS(71.3,",DR="[RA COMMON PROCEDURE EDIT]" D ^DIE 108 S RAMIS713(0)=$G(^RAMIS(71.3,RADA,0)) 109 ; If the procedure is different than the one originally selected and 110 ; the CPRS Order Dialog file exists, send the Orderable Item Update 111 ; message to CPRS. 112 I $P(RAMIS713(0),"^")'=$P(RAY,"^",2),($$ORQUIK^RAORDU()=1) D 113 . S RASTAT=RASTAT_0 D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 114 . S RAY=RADA_"^"_$P($G(^RAMIS(71.3,RADA,0)),"^")_"^"_1,RASTAT=0_"^" 115 . Q 116 K %,%X,%Y,C,D,D0,DA,DE,DI,DIE,DQ,DR,X,Y 117 S RASTAT=RASTAT_$S($P($G(^RAMIS(71.3,+RAY,0)),"^",4)]"":1,1:0) 118 ; If before & after statuses differ, and the CPRS Order Dialog file 119 ; exists, send the Orderable Item Update message to CPRS. 120 I $$ORQUIK^RAORDU()=1,(($P(RASTAT,"^")+$P(RASTAT,"^",2))=1) D 121 . D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) 122 . Q 123 L -^RAMIS(RAFILE,RADA) 124 G 131 125 Q13 K DDC,DDH,DISYS,I,POP,RA713 126 Q 127 RESEQ ;Resequence the common procedure list 128 N D,D0,DI,DQ,H,I,J,CNT,DIC,DIE,DR,DA,TXT,X 129 I $D(XPDNM) D ; if called during package install 130 . S TXT(1)=" " 131 . S TXT(2)="Resequencing the Rad/Nuc Med Common Procedure List." 132 . Q 133 E W !!?5,"Resequencing the Rad/Nuc Med Common Procedure List" 134 S DIE="^RAMIS(71.3,",(I,CNT)=0 135 F S I=$O(^RAMIS(71.3,"AA",RAIMGTYI,I)) Q:I'>0 D 136 . S J=0 137 . F S J=$O(^RAMIS(71.3,"AA",RAIMGTYI,I,J)) Q:J'>0 I $D(^RAMIS(71.3,J,0)) D 138 .. S DA=J,CNT=CNT+1 N I,J 139 .. S DR="3////^S X=CNT" D ^DIE W:'$D(XPDNM) "." 140 .. Q 141 . Q 142 I $D(XPDNM) D ; if called during package install 143 . S TXT(2)=$G(TXT(2))_" Done!" 144 . D MES^XPDUTL(.TXT) 145 . Q 146 E W " Done!" 147 Q 148 LOW(X) ; Find the lowest available sequence number for a procedure within 149 ; a specific Imaging Type. Seq. #'s range from 1 to 40. If the 150 ; range changes in the DD i.e, ^DD(71.3,3, this code as well as the 151 ; code if EN3^RAUTL18 must also be altered. 152 ; If RAHIT is passed back as "", there is no available sequence number. 153 N RA,RAHIT S RAHIT="" 154 F RA=1:1:40 D Q:RAHIT 155 . Q:$D(^RAMIS(71.3,"AA",X,RA)) 156 . S:RAHIT="" RAHIT=RA 157 . Q 158 Q RAHIT 159 VRDIO(RADA) ; Validate the 'Usual Dose' field within the 'Default Radiopha- 160 ; rmaceuticals' multiple. 'Usual Dose' must fall within the 'Low Adult 161 ; Dose' & 'High Adult Dose' range. This subroutine will display the 162 ; Radiopharmaceutical in question along with the values in question if 163 ; inconsistencies are found. 164 ; 165 ; Input Variable: 'RADA' the ien of the Procedure 166 N RANUC S RADA(1)=RADA,RADA=0 D EN^DDIOL("","","!") 167 F S RADA=$O(^RAMIS(71,RADA(1),"NUC",RADA)) Q:RADA'>0 D 168 . S RANUC(0)=$G(^RAMIS(71,RADA(1),"NUC",RADA,0)) 169 . Q:$P(RANUC(0),"^",2)="" ; no need to validate, nothing input 170 . I '$$USUAL^RADD2(.RADA,$P(RANUC(0),"^",2)) D 171 .. N RARRY S RARRY(1)="For Radiopharmaceutical: " 172 .. S RARRY(1)=RARRY(1)_$$GET1^DIQ(50,+$P(RANUC(0),"^")_",",.01)_$C(7) 173 .. S RARRY(2)="" D EN^DDIOL(.RARRY,"") 174 .. Q 175 . Q 176 Q 177 DELRADE(RADA) ; Delete the Default Radiopharmaceuticals multiple 178 N RADA1 S RADA1=0 179 W !!?3,"Deleting default radiopharmaceuticals for this procedure...",! 180 F S RADA1=$O(^RAMIS(71,RADA,"NUC",RADA1)) Q:RADA1'>0 D 181 . K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 182 . S DA(1)=RADA,DA=RADA1,DIE="^RAMIS(71,"_RADA_",""NUC""," 183 . S DR=".01///@" D ^DIE 184 . Q 185 K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 186 Q 187 ;
Note:
See TracChangeset
for help on using the changeset viewer.
