source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAIN.m@ 789

Last change on this file since 789 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.7 KB
Line 
1RAMAIN ;HISC/FPT,GJC,CAH AISC/MJK,RMO;VMP/PW-Utility File Maintenance ;7/24/02 14:45
2 ;;5.0;Radiology/Nuclear Medicine;**31,43,50,54**;Mar 16, 1998
3 ;
43 ;;Major AMIS Code Enter/Edit
5 N RAI F RAI=1:1:5 W !?9,$P($T(REMIND+RAI),";;",2)
6 S DIR(0)="Y",DIR("B")="No"
7 S DIR("A")=" add/change any AMIS codes and weight"
8 S DIR("A",1)=" Do you have approval from Radiology Service VACO to"
9 D ^DIR K DIR Q:$D(DIRUT) Q:'Y
10L3 S DIC="^RAMIS(71.1,",DIC(0)="AEMQ" W ! D ^DIC K DIC I Y<0 K D,X,Y,DDH,I,POP,DISYS Q
11 S DA=+Y,DIE="^RAMIS(71.1,",DR=".01;2" D ^DIE K %,%W,%Y,D0,DA,DE,DQ,DIE,DR,DI,I,POP G L3
12REMIND ;;
13 ;;+----------------------------------------------------------+
14 ;;| New entries and modifications to existing entries are |
15 ;;| prohibited without approval from Radiology Service VACO. |
16 ;;+----------------------------------------------------------+
17 ;
184 ;;Film Type Enter/Edit
19 K DD,DIC,DLAYGO,DO
20 S DIC="^RA(78.4,",DIC(0)="AEMQL",DLAYGO=78.4 W ! D ^DIC
21 K DD,DIC,DLAYGO,DO
22 I +Y<0 D D Q4 Q
23 . D DSPLNKS^RAMAIN1
24 . K D,DI,X,Y
25 . Q
26 S DA=+Y,DIE="^RA(78.4,",DR=".01;2;3;4;5;S:+X'=1 Y=""@1"";6;@1"
27 D ^DIE S RA784=$G(^RA(78.4,DA,0)),RA784(1)=$P(RA784,U)
28 S RA784(5)=+$P(RA784,U,4),RA784(6)=$P(RA784,U,5)
29 I RA784(5),(RA784(6)']"") D
30 . N DIE,DR
31 . W !!?5,$C(7),"'"_RA784(1)_"' has been defined as a wasted film size."
32 . W !?5,"If a particular film size is deemed as a wasted piece of"
33 . W !?5,"film, the wasted piece of film must be associated with an"
34 . W !?5,"unwasted piece of film."
35 . W !!?5,"Redefining '"_RA784(1)_"' as an unwasted film size."
36 . S DIE="^RA(78.4,",DR="5///@" D ^DIE W " Done!"
37 . Q
38 K %,D0,DA,DE,DQ,DIE,DR,RA784,X,Y G 4
39Q4 K I,POP,DISYS,DDH
40 Q
41 ;
425 ;;Diagnostic Code Enter/Edit
43 S DIC="^RA(78.3,",DIC(0)="AEMQL",DLAYGO=78.3 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,POP,I Q
44 S DA=+Y,DIE="^RA(78.3,",DR="2:5" D ^DIE K %,D0,DA,DE,DQ,DIE,DR,I,DI G 5
45 ;
466 ;;Flash Card/Label Formatter
47 W:'$D(RAFLH) !!?5,">>> Exam Label/Report Header/Report Footer/Flash Card Formatter <<<"
48 S DIC="^RA(78.2,",DIC(0)="AEMQL",DLAYGO=78.2 W ! D ^DIC K DIC,DLAYGO G Q6:Y<0 S (RAFLH,DA)=+Y,DIE="^RA(78.2,",DR="[RA FLASH CARD EDIT]" D ^DIE K DE,DQ,DIE,DR I '$D(^RA(78.2,RAFLH,0)) G Q6
49 S RAFMT=RAFLH,RAK=0
50 F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D SETFLH^RAFLH2(RAK)
51 D CMP^RAFLH1
52 W !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>"
53 W !!,"0--------1---------2---------3---------4---------5---------6---------7---------8"
54 W !,"1 0 0 0 0 0 0 0 0",! S RATEST="",RANUM=1,RAFFLF="!" D PRT^RAFLH K RAFFLF W !! G 6
55Q6 S RAK=0 F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D KILFLH^RAFLH2(RAK)
56 K %,%W,%X,%Y,D,D0,D1,DA,FL,RA787,RATEST,RAII,RAK,RAFLH,RAFMT,RANUM,X,Y
57 K POP,I,DDH,DUOUT,DI,DISYS
58 Q
59 ;
607 ;;Complication Type Enter/Edit
61 S DIC="^RA(78.1,",DIC(0)="AEMQL",DLAYGO=78.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y G Q7
62 S DA=+Y,DIE="^RA(78.1,",DR=".01;2" D ^DIE K %,D,D0,DA,DE,DQ,DIE,DR D Q7 G 7
63Q7 K DI,DISYS,I,POP Q
64 ;
658 ;;Sharing/Contract Agreement Entry/Edit
66 S DIC="^DIC(34,",DIC(0)="AELMQ",DIC("A")="Select Agreement/Contract: ",DLAYGO=34 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,I,POP Q
67 S DA=+Y,DIE="^DIC(34,",DR=".01:3" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS G 8
68 ;
699 ;;Standard Reports
70 S DIC="^RA(74.1,",DIC(0)="AEMQL",DLAYGO=74.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y D Q9 Q
71 S DA=+Y,DIE="^RA(74.1,",DR="[RA STANDARD REPORT ENTRY]" D ^DIE K %,%W,%X,%Y,C,D,D0,DA,DE,DQ,DIE,DR,X,Y D Q9 G 9
72Q9 K DDH,DI,DISYS,I,J,POP
73 Q
74 ;
7510 ;;Procedure Modifiers Entry
76 K DD,DO,DLAYGO,DIC,DA,DINUM,X,Y
77 S (DIC,DLAYGO)="^RAMIS(71.2,",DIC(0)="AEMQL"
78 S DIC("A")="Select Procedure Modifier: ",DIC("W")="D PROHLP^RAMAIN"
79 W ! D ^DIC K DIC,DLAYGO I +Y'>0 K D,X,Y,POP,I,DDH,DG,DISYS,DUOUT Q
80 S DIE="^RAMIS(71.2,",DA=+Y,DR="3;4" D ^DIE
81 K %W,%X,%Y,D,DIE,DO,DD,DLAYGO,DA,DR,X,Y,POP,I,D0,DI,DISYS,DQ,C G 10
82 ;
8311 ;;Reports Distribution Edit
84 S DIC="^RABTCH(74.3,",DIC(0)="AEMQ" W ! D ^DIC K DIC I Y<0 K D,X,Y,I,POP Q
85 S DA=+Y,DIE="^RABTCH(74.3,",DR="[RA DISTRIBUTION EDIT]" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS,I,POP G 11
86 ;
8712 ;;Rad/Nuc Med Procedure Message Enter/Edit
88 S DIC="^RAMIS(71.4,",DIC(0)="AELMQ",DLAYGO=71.4
89 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,DTOUT,DUOUT,X,Y Q
90 S DA=+Y
91 L +^RAMIS(71.4,DA):3 I '$T D G 12 ;*54
92 . K DIR S DIR(0)="EA",DIR("A")="Sorry, someone else is editing that entry. <cr> - continue " D ^DIR K DIR
93 K RAMLNA,RAMLNB S RAMSGDA=DA ;*50
94 S RAMLNA=$G(^RAMIS(71.4,DA,0)) ;*50
95 S DIE="^RAMIS(71.4,",DR=.01 D ^DIE
96 S RAMLNB=$G(^RAMIS(71.4,+$G(DA),0)) ;*50
97 I RAMLNB'=RAMLNA S DA=RAMSGDA D ORDITMS^RAMAIN3 ;*50
98 L -^RAMIS(71.4,RAMSGDA) ;*54
99 K %,%W,%X,%Y,D0,DA,DE,DQ,DR,DIE,X,Y,RAMLNA,RAMLNB,RAMSGDA
100 G 12
101 ;
10213 ;;Cost of Procedure Enter/Edit
103 I '$D(RACCESS(DUZ)) D SET^RAPSET1 I $D(XQUIT) K RACCESS,XQUIT Q
104 ; ask img type
105 K ^TMP($J,"RA I-TYPE") D SELIMG^RAUTL7 G:$G(RAQUIT) 139
106 N RA0,RA1,RA2 S RA0="",RA2=""
107131 S RA0=$O(^TMP($J,"RA I-TYPE",RA0)) G:RA0="" 133
108132 S RA1=$O(^TMP($J,"RA I-TYPE",RA0,0)) G:'RA1 131
109 S RA2=RA1_U_RA2 G 131
110133 G:RA2="" 139 S DIC="^RAMIS(71,",DIC(0)="AEMQ"
111 ; restrict choice of procedure by img type selected
112 S DIC("S")="I RA2[$P(^(0),U,12)"
113 W ! D ^DIC K DIC I Y<0 K %,DTOUT,DUOUT,DIC,X,Y G 139
114 S DA=+Y,DIE="^RAMIS(71,",DR=10 D ^DIE
115 K D,D0,DA,DDH,DI,DIC,DIE,DQ,DR,X
116 G 133
117139 K ^TMP($J,"RA I-TYPE"),RAQUIT
118 Q
119 ;
120PROHLP ; Help displays the modifiers and all associated imaging types.
121 D:'$D(IOM) HOME^%ZIS
122 N RAIT,RAIT1,RAIT2,RAIT3 Q:'+$O(^RAMIS(71.2,+Y,1,0)) ; Quit, no data
123 S (RAIT,RAIT3)=0
124 F S RAIT=+$O(^RAMIS(71.2,+Y,1,RAIT)) W:'RAIT ")" Q:'RAIT D
125 . S RAIT1=+$G(^RAMIS(71.2,+Y,1,RAIT,0))
126 . S RAIT2=$P($G(^RA(79.2,RAIT1,0)),"^",3)
127 . W:($X+5)>IOM !?2 W ?$X+1 W:'RAIT3 "(" W RAIT2 S RAIT3=1
128 . Q
129 Q
Note: See TracBrowser for help on using the repository browser.