source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJMN3.m@ 1806

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1MAGJMN3 ;WIRMFO/JHC VRad Maint functions ; 10 Jun 2005 2:39 PM
2 ;;3.0;IMAGING;**18**;Mar 07, 2006
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20YN(MSG,DFLT) ; get Yes/No reply
21 N X I $G(DFLT)="" S DFLT="N"
22 W !
23 S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES")
24YN1 W !,MSG_" "_DFLT_"// "
25 R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN")
26 I "YN"'[X W " ??? Enter YES or NO",! G YN1
27 Q X
28 ;
29EECPT ;Enter/Edit CPT MATCHING SET
30 W @IOF,!!?10,"** Enter/Edit VistARad RAD CPT MATCHING CPT CODE **",!!
31 N MAGIEN
32 K DIC S (DIC,DLAYGO)=2006.67,DIC(0)="ALMEQN"
33 D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q
34 S DIE=2006.67,DA=+Y,DR="1;3;4;5"
35 S MAGIEN=DA
36 D ^DIE I '$D(DA) G EECPT
37 G EECPT
38 Q
39INCPT ; Inquire MAG RAD CPT MATCHING
40 W @IOF,!!?10,"** Inquire VistARad CPT MATCHING CPT CODE **",!!
41 N MAGIEN,BY,FR,TO
42 S DIC=2006.67,DIC(0)="AMEQ"
43 D ^DIC I Y=-1 K DIC Q
44 S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0
45 S BY="#.01",DIS(0)="I D0=MAGIEN"
46 D EN^DIP
47 R !,"Enter RETURN to continue: ",X:DTIME W !
48 G INCPT
49 Q
50PRCPT ;Print MAG RAD CPT MATCHING LOGIC
51 N FLDS
52 W @IOF,!!?10,"** Print VistARad CPT MATCHING CPT CODE **",!!
53 W !! S DIC=2006.67,L=0,FLDS="[MAGJ CPT MATCH PRT]"
54 D EN1^DIP
55 R !,"Enter RETURN to continue: ",X:DTIME W !
56 Q
57 ;
58END ;
Note: See TracBrowser for help on using the repository browser.