1 | PXRMFLST ; SLC/PJH - List Resolution Statuses ;03/09/2000
|
---|
2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
3 | ;
|
---|
4 | ;List selected finding type parameter
|
---|
5 | ;------------------------------------
|
---|
6 | START N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y
|
---|
7 | ;Get lists of finding types for display
|
---|
8 | N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
|
---|
9 | ;
|
---|
10 | SELECT S MODE=""
|
---|
11 | S DIC="^PXRMD(801.45,"
|
---|
12 | S DIC(0)="AEMQ"
|
---|
13 | S DIC("A")="Select Finding Type: "
|
---|
14 | D ^DIC
|
---|
15 | I Y'=-1 D G SELECT
|
---|
16 | .D SET
|
---|
17 | .D DISP
|
---|
18 | END Q
|
---|
19 | ;
|
---|
20 | ;List all statuses
|
---|
21 | ;-----------------
|
---|
22 | ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y
|
---|
23 | S Y=1,MODE="GENERAL"
|
---|
24 | ;Get lists of finding types for display
|
---|
25 | N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
|
---|
26 | ; Set Date for Header
|
---|
27 | S NOW=$$NOW^XLFDT
|
---|
28 | S NOW=$$FMTE^XLFDT(NOW,"1P")
|
---|
29 | D SET
|
---|
30 | S DIC="^PXRMD(801.45,"
|
---|
31 | S BY=".01"
|
---|
32 | S FR="",TO=""
|
---|
33 | S DHD="W ?0 D HED^PXRMFLST"
|
---|
34 | D DISP
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
|
---|
38 | ;--------------------
|
---|
39 | INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO
|
---|
40 | ;Get lists of finding types for display
|
---|
41 | N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
|
---|
42 | S MODE=""
|
---|
43 | S DIC="^PXRMD(801.45,"
|
---|
44 | S DIC(0)="AEMQ"
|
---|
45 | D SET
|
---|
46 | D DISP
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | HED ; Display Header (see DHD variable)
|
---|
50 | N TEMP,TEXTLEN,TEXTHED,TEXTUND
|
---|
51 | S TEXTHED="RESOLUTION STATUS LIST"
|
---|
52 | S TEXTUND=$TR($J("",IOM)," ","-")
|
---|
53 | S TEMP=NOW_" Page "_DC
|
---|
54 | S TEXTLEN=$L(TEMP)
|
---|
55 | W TEXTHED
|
---|
56 | W ?(IOM-TEXTLEN),TEMP
|
---|
57 | W !,TEXTUND,!!
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | DISP ;DISPLAY (Display from FLDS array)
|
---|
61 | S L=0,FLDS="[PXRM FINDING TYPE PARAMETERS]"
|
---|
62 | D EN1^DIP
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | SET ;Setup all the variables
|
---|
66 | ;
|
---|
67 | ; Set Date for Header
|
---|
68 | S NOW=$$NOW^XLFDT
|
---|
69 | S NOW=$$FMTE^XLFDT(NOW,"1P")
|
---|
70 | ;
|
---|
71 | ;These variables need to be setup every time because DIP kills them.
|
---|
72 | S BY="NUMBER"
|
---|
73 | S (FR,TO)=+$P(Y,U,1)
|
---|
74 | S DHD="W ?0 D HED^PXRMFLST"
|
---|
75 | ;
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | FDES N X S X=$P($G(^PXRMD(801.45,D0,0)),U) Q:X=""
|
---|
79 | I X="POV" W "(DIAGNOSIS)" Q
|
---|
80 | I X="CPT" W "(PROCEDURE)" Q
|
---|
81 | W "("_$G(DEF2(X))_")"
|
---|
82 | Q
|
---|