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
Q
;
;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
Q
;
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,!!
Q
;
DISP ;DISPLAY (Display from FLDS array)
S L=0
D EN1^DIP
Q
;
;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
Q
;
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
Q
;
;Resolution type
TYP I +$P($G(^PXRMD(801.9,+D0,0)),U,6) W ?20,"NATIONAL" Q
W ?20,"LOCAL"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSLST 2264 printed Oct 16, 2024@17:50:01 Page 2
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
