| 1 | PXRMSLST ; SLC/PJH - List Resolution Statuses ;03/09/2000
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;List selected status
|
|---|
| 5 | ;--------------------
|
|---|
| 6 | START N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y
|
|---|
| 7 | ;
|
|---|
| 8 | SELECT 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
|
|---|
| 16 | END Q
|
|---|
| 17 | ;
|
|---|
| 18 | ;List all statuses
|
|---|
| 19 | ;-----------------
|
|---|
| 20 | ALL 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 | ;--------------------
|
|---|
| 33 | INQ(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 | ;
|
|---|
| 41 | HED ; 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 | ;
|
|---|
| 52 | DISP ;DISPLAY (Display from FLDS array)
|
|---|
| 53 | S L=0
|
|---|
| 54 | D EN1^DIP
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;Work out national resolution status
|
|---|
| 58 | NAT 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 | ;
|
|---|
| 70 | SET ;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
|
|---|
| 94 | TYP I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?20,"NATIONAL" Q
|
|---|
| 95 | W ?20,"LOCAL"
|
|---|
| 96 | Q
|
|---|
