| [623] | 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 | ;
|
|---|
