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