source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSLST.m@ 975

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PXRMSLST ; SLC/PJH - List Resolution Statuses ;03/09/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;List selected status
5 ;--------------------
6START N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y
7 ;
8SELECT S MODE=""
9 S DIC="^PXRMD(801.9,"
10 S DIC(0)="AEMQ"
11 S DIC("A")="Select Resolution Status: "
12 D ^DIC
13 I Y'=-1 D G SELECT
14 .D SET
15 .D DISP
16END Q
17 ;
18 ;List all statuses
19 ;-----------------
20ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y
21 S Y=1,MODE="GENERAL"
22 D SET
23 S DIC="^PXRMD(801.9,"
24 S BY=".01"
25 S FR=""
26 S TO=""
27 S DHD="W ?0 D HED^PXRMSLST"
28 D DISP
29 Q
30 ;
31 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
32 ;--------------------
33INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO
34 S MODE=""
35 S DIC="^PXRMD(801.9,"
36 S DIC(0)="AEMQ"
37 D SET
38 D DISP
39 Q
40 ;
41HED ; Display Header (see DHD variable)
42 N TEMP,TEXTLEN,TEXTHED,TEXTUND
43 S TEXTHED="RESOLUTION STATUS LIST"
44 S TEXTUND=$TR($J("",IOM)," ","-")
45 S TEMP=NOW_" Page "_DC
46 S TEXTLEN=$L(TEMP)
47 W TEXTHED
48 W ?(IOM-TEXTLEN),TEMP
49 W !,TEXTUND,!!
50 Q
51 ;
52DISP ;DISPLAY (Display from FLDS array)
53 S L=0
54 D EN1^DIP
55 Q
56 ;
57 ;Work out national resolution status
58NAT N NAT
59 ;Ignore national codes
60 I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?29,"N/A" Q
61 ;Get national code from cross reference
62 S NAT=$O(^PXRMD(801.9,"AC",D0,""))
63 ;If none allocated say so
64 I NAT="" W ?29,"***UNDEFINED***" Q
65 ;Get name of national status and display
66 S DATA=$P($G(^PXRMD(801.9,NAT,0)),U)
67 W ?29,DATA
68 Q
69 ;
70SET ;Setup all the variables
71 N NATIONAL
72 ;
73 ; Set Date for Header
74 S NOW=$$NOW^XLFDT
75 S NOW=$$FMTE^XLFDT(NOW,"1P")
76 ;
77 ;These variables need to be setup every time because DIP kills them.
78 S BY="NUMBER"
79 S (FR,TO)=+$P(Y,U,1)
80 S DHD="W ?0 D HED^PXRMSLST"
81 ;
82 ;If the status is resticted edit then this is a national code
83 S NATIONAL=+$P($G(^PXRMD(801.9,+Y,0)),U,6)
84 ;
85 ;General display used by list function
86 I MODE="GENERAL" S FLDS="[PXRM RESOLUTIONS (GENERAL)]" Q
87 ;National status display
88 I NATIONAL S FLDS="[PXRM RESOLUTIONS (NATIONAL)]" Q
89 ;Local Status display
90 I 'NATIONAL S FLDS="[PXRM RESOLUTIONS (LOCAL)]" Q
91 Q
92 ;
93 ;Resolution type
94TYP I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?20,"NATIONAL" Q
95 W ?20,"LOCAL"
96 Q
Note: See TracBrowser for help on using the repository browser.