PXRMFLST.m

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

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

 ;

 ;List selected finding type parameter

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

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

 ;Get lists of finding types for display

 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 ;

SELECT S MODE=""

 S DIC="^PXRMD(801.45,"

 S DIC(0)="AEMQ"

 S DIC("A")="Select Finding Type: "

 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"

 ;Get lists of finding types for display

 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 ; Set Date for Header

 S NOW=$$NOW^XLFDT

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

 D SET

 S DIC="^PXRMD(801.45,"

 S BY=".01"

 S FR="",TO=""

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

 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

 ;Get lists of finding types for display

 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 S MODE=""

 S DIC="^PXRMD(801.45,"

 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,FLDS="[PXRM FINDING TYPE PARAMETERS]"

 D EN1^DIP

 Q

 ;

SET ;Setup all the variables

 ;

 ; 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^PXRMFLST"

 ;

 Q

 ;

FDES N X S X=$P($G(^PXRMD(801.45,D0,0)),U) Q:X="" 

 I X="POV" W "(DIAGNOSIS)" Q

 I X="CPT" W "(PROCEDURE)" Q

 W "("_$G(DEF2(X))_")"

 Q

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

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

 +2       ;

 +3       ;List selected finding type parameter

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

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

 +1       ;Get lists of finding types for display

 +2        NEW DEF,DEF1,DEF2

           DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 +3       ;

SELECT     SET MODE=""

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

 +2        SET DIC(0)="AEMQ"

 +3        SET DIC("A")="Select Finding Type: "

 +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       ;Get lists of finding types for display

 +3        NEW DEF,DEF1,DEF2

           DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 +4       ; Set Date for Header

 +5        SET NOW=$$NOW^XLFDT

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

 +7        DO SET

 +8        SET DIC="^PXRMD(801.45,"

 +9        SET BY=".01"

 +10       SET FR=""

           SET TO=""

 +11       SET DHD="W ?0 D HED^PXRMFLST"

 +12       DO DISP

 +13       QUIT 

 +14      ;

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

 +16      ;--------------------

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

 +1       ;Get lists of finding types for display

 +2        NEW DEF,DEF1,DEF2

           DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)

 +3        SET MODE=""

 +4        SET DIC="^PXRMD(801.45,"

 +5        SET DIC(0)="AEMQ"

 +6        DO SET

 +7        DO DISP

 +8        QUIT 

 +9       ;

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

           SET FLDS="[PXRM FINDING TYPE PARAMETERS]"

 +2        DO EN1^DIP

 +3        QUIT 

 +4       ;

SET       ;Setup all the variables

 +1       ;

 +2       ; Set Date for Header

 +3        SET NOW=$$NOW^XLFDT

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

 +5       ;

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

 +7        SET BY="NUMBER"

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

 +9        SET DHD="W ?0 D HED^PXRMFLST"

 +10      ;

 +11       QUIT 

 +12      ;

FDES       NEW X

           SET X=$PIECE($GET(^PXRMD(801.45,D0,0)),U)

           IF X=""

               QUIT 

 +1        IF X="POV"

               WRITE "(DIAGNOSIS)"

               QUIT 

 +2        IF X="CPT"

               WRITE "(PROCEDURE)"

               QUIT 

 +3        WRITE "("_$GET(DEF2(X))_")"

 +4        QUIT