Routine: PXRMSLST

PXRMSLST ; SLC/PJH - List Resolution Statuses ;03/09/2000

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;List selected status

 ;--------------------

START N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y

SELECT S MODE=""

 S DIC="^PXRMD(801.9,"

 S DIC(0)="AEMQ"

 S DIC("A")="Select Resolution Status: "

 D ^DIC

 I Y'=-1 D  G SELECT

 .D SET

 .D DISP

END Q

 ;List all statuses

 ;-----------------

ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y

 S Y=1,MODE="GENERAL"

 D SET

 S DIC="^PXRMD(801.9,"

 S BY=".01"

 S FR=""

 S TO=""

 S DHD="W ?0 D HED^PXRMSLST"

 D DISP

 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)

 ;--------------------

INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO

 S MODE=""

 S DIC="^PXRMD(801.9,"

 S DIC(0)="AEMQ"

 D SET

 D DISP

HED ; Display Header (see DHD variable)

 N TEMP,TEXTLEN,TEXTHED,TEXTUND

 S TEXTHED="RESOLUTION STATUS LIST"

 S TEXTUND=$TR($J("",IOM)," ","-")

 S TEMP=NOW_"  Page "_DC

 S TEXTLEN=$L(TEMP)

 W TEXTHED

 W ?(IOM-TEXTLEN),TEMP

 W !,TEXTUND,!!

DISP ;DISPLAY (Display from FLDS array)

 S L=0

 D EN1^DIP

 ;Work out national resolution status

NAT N NAT

 ;Ignore national codes

 I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?29,"N/A" Q

 ;Get national code from cross reference

 S NAT=$O(^PXRMD(801.9,"AC",D0,""))

 ;If none allocated say so

 I NAT="" W ?29,"***UNDEFINED***" Q

 ;Get name of national status and display

 S DATA=$P($G(^PXRMD(801.9,NAT,0)),U)

 W ?29,DATA

SET ;Setup all the variables

 N NATIONAL

 ; Set Date for Header

 S NOW=$$NOW^XLFDT

 S NOW=$$FMTE^XLFDT(NOW,"1P")

 ;These variables need to be setup every time because DIP kills them.

 S BY="NUMBER"

 S (FR,TO)=+$P(Y,U,1)

 S DHD="W ?0 D HED^PXRMSLST"

 ;If the status is resticted edit then this is a national code

 S NATIONAL=+$P($G(^PXRMD(801.9,+Y,0)),U,6)

 ;General display used by list function

 I MODE="GENERAL" S FLDS="[PXRM RESOLUTIONS (GENERAL)]" Q

 ;National status display

 I NATIONAL S FLDS="[PXRM RESOLUTIONS (NATIONAL)]" Q

 ;Local Status display

 I 'NATIONAL S FLDS="[PXRM RESOLUTIONS (LOCAL)]" Q

 ;Resolution type

TYP I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?20,"NATIONAL" Q

 W ?20,"LOCAL"

PXRMSLST  ; SLC/PJH - List Resolution Statuses ;03/09/2000

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;List selected status

 +4       ;--------------------

START      NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y

 +1       ;

SELECT     SET MODE=""

 +1        SET DIC="^PXRMD(801.9,"

 +2        SET DIC(0)="AEMQ"

 +3        SET DIC("A")="Select Resolution Status: "

 +4        DO ^DIC

 +5        IF Y'=-1

               Begin DoDot:1

 +6                DO SET

 +7                DO DISP

               End DoDot:1

               GOTO SELECT

END        QUIT

 +1       ;

 +2       ;List all statuses

 +3       ;-----------------

ALL        NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO,Y

 +1        SET Y=1

           SET MODE="GENERAL"

 +2        DO SET

 +3        SET DIC="^PXRMD(801.9,"

 +4        SET BY=".01"

 +5        SET FR=""

 +6        SET TO=""

 +7        SET DHD="W ?0 D HED^PXRMSLST"

 +8        DO DISP

 +9        QUIT

 +10      ;

 +11      ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)

 +12      ;--------------------

INQ(Y)     NEW BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,MODE,NOW,TO

 +1        SET MODE=""

 +2        SET DIC="^PXRMD(801.9,"

 +3        SET DIC(0)="AEMQ"

 +4        DO SET

 +5        DO DISP

 +6        QUIT

 +7       ;

HED       ; Display Header (see DHD variable)

 +1        NEW TEMP,TEXTLEN,TEXTHED,TEXTUND

 +2        SET TEXTHED="RESOLUTION STATUS LIST"

 +3        SET TEXTUND=$TRANSLATE($JUSTIFY("",IOM)," ","-")

 +4        SET TEMP=NOW_"  Page "_DC

 +5        SET TEXTLEN=$LENGTH(TEMP)

 +6        WRITE TEXTHED

 +7        WRITE ?(IOM-TEXTLEN),TEMP

 +8        WRITE !,TEXTUND,!!

 +9        QUIT

 +10      ;

DISP      ;DISPLAY (Display from FLDS array)

 +1        SET L=0

 +2        DO EN1^DIP

 +3        QUIT

 +4       ;

 +5       ;Work out national resolution status

NAT        NEW NAT

 +1       ;Ignore national codes

 +2        IF +$PIECE($GET(^PXRMD(801.9,+D0,0)),U,6)

               WRITE ?29,"N/A"

               QUIT

 +3       ;Get national code from cross reference

 +4        SET NAT=$ORDER(^PXRMD(801.9,"AC",D0,""))

 +5       ;If none allocated say so

 +6        IF NAT=""

               WRITE ?29,"***UNDEFINED***"

               QUIT

 +7       ;Get name of national status and display

 +8        SET DATA=$PIECE($GET(^PXRMD(801.9,NAT,0)),U)

 +9        WRITE ?29,DATA

 +10       QUIT

 +11      ;

SET       ;Setup all the variables

 +1        NEW NATIONAL

 +2       ;

 +3       ; Set Date for Header

 +4        SET NOW=$$NOW^XLFDT

 +5        SET NOW=$$FMTE^XLFDT(NOW,"1P")

 +6       ;

 +7       ;These variables need to be setup every time because DIP kills them.

 +8        SET BY="NUMBER"

 +9        SET (FR,TO)=+$PIECE(Y,U,1)

 +10       SET DHD="W ?0 D HED^PXRMSLST"

 +11      ;

 +12      ;If the status is resticted edit then this is a national code

 +13       SET NATIONAL=+$PIECE($GET(^PXRMD(801.9,+Y,0)),U,6)

 +14      ;

 +15      ;General display used by list function

 +16       IF MODE="GENERAL"

               SET FLDS="[PXRM RESOLUTIONS (GENERAL)]"

               QUIT

 +17      ;National status display

 +18       IF NATIONAL

               SET FLDS="[PXRM RESOLUTIONS (NATIONAL)]"

               QUIT

 +19      ;Local Status display

 +20       IF 'NATIONAL

               SET FLDS="[PXRM RESOLUTIONS (LOCAL)]"

               QUIT

 +21       QUIT

 +22      ;

 +23      ;Resolution type

TYP        IF +$PIECE($GET(^PXRMD(801.9,+D0,0)),U,6)

               WRITE ?20,"NATIONAL"

               QUIT

 +1        WRITE ?20,"LOCAL"

 +2        QUIT

PXRMSLST.m