Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLLA.m

    r613 r623  
    1 PXRMDLLA        ;SLC/PJH - REMINDER DIALOG LOADER ;11/08/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;
    4 FREC(DFIEN,DFTYP)       ;Build type 3 record
    5         N CSARRAY,CSCNT
    6         ;Dialog type/text and resolution 
    7         S DNAM=$$NAME(DFIEN,DFTYP)
    8         D CODE^PXRMDLLB(DFIEN,DFTYP,.CSARRAY)
    9         I $D(CSARRAY)>0 D  Q
    10         . S CSCNT="" F  S CSCNT=$O(CSARRAY(CSCNT)) Q:CSCNT=""  D
    11         . . S OCNT=OCNT+1
    12         . . S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(CSARRAY(CSCNT))_U_DNAM_U_U_DVIT
    13         ;Translate vitals ien to PCE code - This will need a DBIA
    14         S DCOD=""
    15         I DPCE="VIT" D
    16         .S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
    17         .;Vitals Caption
    18         .S DVIT=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
    19         I DFTYP]"" D
    20         .S OCNT=OCNT+1
    21         .S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(DCOD)_U_DNAM_U_U_DVIT
    22         .;Get order type for orderable items
    23         .;DBIA #3110
    24         .S:DPCE="Q" $P(ORY(OCNT),U,11)=$P($G(^ORD(101.41,DFIEN,0)),U,4)
    25         .;If mental health check if a GAF score and if MH test is required
    26         .I DPCE="MH",DFIEN D
    27         ..;DBIA #5044
    28         ..I $P($G(^YTT(601.71,DFIEN,0)),U)="GAF" S $P(ORY(OCNT),U,12)=1
    29         ..;Check to see if the MH test is required
    30         ..S $P(ORY(OCNT),U,13)=+$P($G(^PXRMD(801.41,DITEM,0)),U,18)
    31         ..I $P(ORY(OCNT),U,13)=2,$$PATCH^XPDUTL("OR*3.0*243")=0 S $P(ORY(OCNT),U,13)=1
    32         Q
    33         ;
    34 GUI(IEN)        ;Work out prompt type for PCE
    35         Q:IEN="" ""
    36         N SUB S SUB=$P($G(^PXRMD(801.41,IEN,46)),U)
    37         Q:'SUB ""
    38         Q $P($G(^PXRMD(801.42,SUB,0)),U)
    39         ;
    40 LOAD(DITEM,DCUR,DTTYP)  ;Load dialog questions into array
    41         N DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
    42         N DVIT,NODE,CNT,IDENT
    43         ;DBIA #3110    OR(101.41
    44         ;
    45         ;Build list of PCE codes
    46         S DARRAY("AUTTEDT(")="PED"
    47         S DARRAY("AUTTEXAM(")="XAM"
    48         S DARRAY("AUTTHF(")="HF"
    49         S DARRAY("AUTTIMM(")="IMM"
    50         S DARRAY("AUTTSK(")="SK"
    51         ;
    52         S DARRAY("GMRD(120.51,")="VIT"
    53         S DARRAY("ORD(101.41,")="Q"
    54         S DARRAY("YTT(601.71,")="MH"
    55         ;
    56         S DARRAY("ICD9(")="POV"
    57         S DARRAY("ICPT(")="CPT"
    58         S DARRAY("WV(790.404,")="WH"
    59         S DARRAY("WV(790.1,")="WHR"
    60         ;
    61         S DARRAY("PXD(811.2,")="T"
    62         ;
    63         ;Get the dialog element
    64         S OCNT=0
    65         N TERMNODE,TERMSTAT,TERMOUT
    66         S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4)
    67         ;Finding detail
    68         S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
    69         S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
    70         ;check for WH finding
    71         I $P($G(^PXRMD(801.41,DITEM,0)),U,16)["WHR" S DFIND=$G(WHFIND)
    72         ;
    73         S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
    74         S DPCE="",DVIT="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
    75         ;Exclude from P/N
    76         S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
    77         ;
    78         ;Non taxonomy codes (3 - finding record)
    79         I DPCE'="T" D FREC(DFIEN,DFTYP)
    80         ;
    81         ;Taxonomy codes need expanding (3 - finding record)
    82         I DPCE="T" D EXP^PXRMDLLB(DFIEN,DCUR,DTTYP)
    83         ;
    84         ;Prompt details (4 - prompt records)
    85         N ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
    86         ;If not a taxonomy get prompts from dialog file
    87         I DPCE'="T" D PROTH(DITEM)
    88         ;Check for MST findings
    89         I (DPCE'="T"),(DFTYP]"") D MST^PXRMDLLB(DFTYP,DFIEN)
    90         ;If taxonomy use finding parameters (CPT/POV)
    91         I DPCE="T" D
    92         .;Quit if finding type not passed
    93         .Q:DTTYP=""
    94         .N RSUB,FNODE
    95         .;Get parameter file node for this finding type
    96         .S FNODE=$O(^PXRMD(801.45,"B",DTTYP,"")) Q:FNODE=""
    97         .;Derive resolution from line ien 1=done 2=done elsewhere
    98         .S RSUB=DCUR+1 I (RSUB<1)!(RSUB>2) Q
    99         .;Get details from 811.5
    100         .D PRTAX(FNODE,RSUB)
    101         ;Return array of type 4 records
    102         S DSEQ=""
    103         F  S DSEQ=$O(ARRAY(DSEQ)) Q:'DSEQ  D
    104         .S OCNT=OCNT+1
    105         .S ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
    106         .S DSSEQ=""
    107         .F  S DSSEQ=$O(ARRAY(DSEQ,DSSEQ)) Q:'DSSEQ  D
    108         ..S OCNT=OCNT+1
    109         ..S ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
    110         ;
    111         ;Get progress note text if defined
    112         I DPCE'="T" D:'DEXC PTXT(DITEM)
    113         ;Additional findings
    114         N FASUB
    115         S FASUB=0
    116         F  S FASUB=$O(^PXRMD(801.41,DITEM,3,FASUB)) Q:'FASUB  D
    117         .S DFIND=$P($G(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
    118         .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2) Q:DFTYP=""  Q:DFIEN=""
    119         .S DVIT="",DPCE=$G(DARRAY(DFTYP))
    120         .I DPCE'="" D FREC(DFIEN,DFTYP)
    121         Q
    122         ;
    123         ;
    124         ;Returns item name
    125 NAME(DFIEN,DFTYP)       ;
    126         Q:DFTYP="" ""
    127         Q:DFIEN="" ""
    128         N NAME,FGLOB,POSN
    129         ;DBIA #4108
    130         I DFTYP="WV(790.404," S NAME=$P($G(^WV(790.404,DFIEN,0)),U) Q:NAME]"" NAME
    131         I DFTYP="WV(790.1," S NAME=$G(WHNAME) K WHNAME Q:NAME]"" NAME
    132         S POSN=2
    133         S:DFTYP["AUTT" POSN=1 S:DFTYP["AUTTEDT" POSN=4 S:DFTYP["ICD" POSN=3
    134         S FGLOB=U_DFTYP_DFIEN_",0)",NAME=$P($G(@FGLOB),U,POSN)
    135         I (POSN>1),NAME="" S NAME=$P($G(@FGLOB),U)
    136         I NAME="" S NAME=DFIEN
    137         Q NAME
    138         ;
    139 PROTH(IEN)      ; Additional prompts defined in 801.41
    140         N DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
    141         N DTXT,DTYP,PRINT
    142         S DSEQ=0
    143         F  S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",DSEQ)) Q:'DSEQ  D
    144         .;Get prompts in sequence
    145         .S DSUB=$O(^PXRMD(801.41,IEN,10,"B",DSEQ,"")) Q:'DSUB
    146         .;Prompt ien
    147         .S DIEN=$P($G(^PXRMD(801.41,IEN,10,DSUB,0)),U,2) Q:'DIEN
    148         .;Ignore disabled components, and those that are not prompts
    149         .Q:($P($G(^PXRMD(801.41,DIEN,0)),U,3)]"")!("PF"'[$P($G(^(0)),U,4))
    150         .;Set defaults to null
    151         .S DDEF="",DEXC="",DREQ="",DSNL=""
    152         .;Prompt name and GUI process (quit if null)
    153         .S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U),DGUI=$$GUI(DIEN)
    154         .I $G(DGUI)="WH_NOT_PURP" D
    155         ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
    156         .;Type Prompt or Forced
    157         .S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
    158         .I "PF"[DTYP D
    159         ..;Required/Prompt caption
    160         ..S DDATA=$G(^PXRMD(801.41,DIEN,2)),DTXT=$P(DDATA,U,4)
    161         ..;Default value or forced value
    162         ..S:DTYP="P" DDEF=$P(DDATA,U) S:DTYP="F" DDEF=$P(DDATA,U,2)
    163         ..;Override caption/start new line/exclude PN from dialog file
    164         ..S DDATA=$G(^PXRMD(801.41,IEN,10,DSUB,0)),DREQ=$P(DDATA,U,9)
    165         ..S DOVR=$P(DDATA,U,6),DSNL=$P(DDATA,U,7),DEXC=$P(DDATA,U,8)
    166         ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
    167         ..;Convert date to fileman format
    168         ..I DGUI="VST_DATE",DDEF["T" S DDEF=$$DT^XLFDT()
    169         .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_$G(DFTEXT)_U_$G(PRINT)
    170         .;the following section add a comment prompt to the WH review of result
    171         .;section of the reminder dialog
    172         .I DGUI="WH_PAP_RESULT",DFTYP="WV(790.1,",DTYP="P" D
    173         ..N WHCNT,WHFLAG,WHNUM,WHLOOP
    174         ..S WHNUM=DSEQ+1,WHLOOP=0
    175         ..F WHLOOP=0 D
    176         ...S (WHCNT,WHFLAG)=0
    177         ...F  S WHCNT=$O(^PXRMD(801.41,IEN,10,"B",WHCNT)) Q:'WHCNT!(WHFLAG=1)  D
    178         ....I WHCNT=WHNUM S WHFLAG=1,WHNUM=WHNUM+1
    179         ...I WHFLAG=0 S WHLOOP=1
    180         ..S ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
    181         .;Additional checkboxes
    182         .I DGUI="COM",DIEN>1 D
    183         ..N DSSEQ,DSUB,DTEXT
    184         ..S DSSEQ=0
    185         ..F  S DSSEQ=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ)) Q:'DSSEQ  D
    186         ...S DSUB=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ,"")) Q:'DSUB
    187         ...S DTEXT=$P($G(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2) Q:DTEXT=""
    188         ...S ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
    189         Q
    190         ;
    191 PRTAX(FNODE,RSUB)       ;Get all additional fields for this resolution type
    192         N ACNT,ASUB
    193         N DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
    194         S ASUB=0,DSEQ=0
    195         F  S ASUB=$O(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB)) Q:'ASUB  D
    196         .S DDATA=$G(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0)) Q:DDATA=""
    197         .;Ignore if disabled
    198         .I $P(DDATA,U,3)=1 Q
    199         .S DSUB=$P(DDATA,U) Q:DDATA=""
    200         .S DSEQ=DSEQ+1
    201         .;Set defaults to null
    202         .S DDEF="",DEXC="",DREQ="",DSNL=""
    203         .;Prompt name and GUI process (quit if null)
    204         .S DNAME=$P($G(^PXRMD(801.41,DSUB,0)),U),DGUI=$$GUI(DSUB)
    205         .I $G(DGUI)="WH_NOT_PURP" D
    206         ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
    207         .;Type Prompt or Forced
    208         .S DTYP=$P($G(^PXRMD(801.41,DSUB,0)),U,4)
    209         .I DTYP="P" D
    210         ..S DREQ=$P(DDATA,U,2),DTXT=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
    211         ..;Override caption/start new line/exclude from PN from finding type
    212         ..S DOVR=$P(DDATA,U,5),DSNL=$P(DDATA,U,6),DEXC=$P(DDATA,U,7)
    213         ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
    214         ..;Required/Prompt caption
    215         ..S DDATA=$G(^PXRMD(801.41,DSUB,2))
    216         .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$G(PRINT)
    217         Q
    218         ;
    219 PTXT(ITEM)      ;Get progress note (WP) text for type 6 records
    220         N ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
    221         S SUB=0
    222         F  S SUB=$O(^PXRMD(801.41,ITEM,35,SUB)) Q:'SUB  D
    223         .S ARRAY(SUB)=$G(^PXRMD(801.41,ITEM,35,SUB,0))
    224         S SUB=0,LAST=0 F  S SUB=$O(ARRAY(SUB)) Q:'SUB  D
    225         .S TEXT=$G(ARRAY(SUB))
    226         .S NULL=0 I (TEXT="")!($E(TEXT)=" ") S NULL=1
    227         .I LAST,'NULL S TEXT="<br>"_TEXT
    228         .S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
    229         .S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
    230         .S OCNT=OCNT+1,ORY(OCNT)=6_U_ITEM_U_U_TEXT
    231         Q
    232         ;
    233 TOK(TIEN,TYPE)  ;Check if selectable codes exist
    234         N DATA,FOUND,SUB
    235         S FOUND=0,SUB=0
    236         F  S SUB=$O(^PXD(811.2,TIEN,TYPE,SUB)) Q:'SUB  D  Q:FOUND
    237         .S DATA=$G(^PXD(811.2,TIEN,TYPE,SUB,0)) Q:DATA=""
    238         .;Ignore disabled codes
    239         .I '$P(DATA,U,3) S FOUND=1
    240         Q FOUND
     1PXRMDLLA ;SLC/PJH - REMINDER DIALOG LOADER ;07/29/2004
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;
     4FREC(DFIEN,DFTYP) ;Build type 3 record
     5 N CSARRAY,CSCNT
     6 ;Dialog type/text and resolution 
     7 S DNAM=$$NAME(DFIEN,DFTYP)
     8 D CODE^PXRMDLLB(DFIEN,DFTYP,.CSARRAY)
     9 I $D(CSARRAY)>0 D  Q
     10 . S CSCNT="" F  S CSCNT=$O(CSARRAY(CSCNT)) Q:CSCNT=""  D
     11 . . S OCNT=OCNT+1
     12 . . S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(CSARRAY(CSCNT))_U_DNAM_U_U_DVIT
     13 ;Translate vitals ien to PCE code - This will need a DBIA
     14 S DCOD=""
     15 I DPCE="VIT" D
     16 .S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
     17 .;Vitals Caption
     18 .S DVIT=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
     19 I DFTYP]"" D
     20 .S OCNT=OCNT+1
     21 .S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(DCOD)_U_DNAM_U_U_DVIT
     22 .;Get order type for orderable items
     23 .;DBIA #3110
     24 .S:DPCE="Q" $P(ORY(OCNT),U,11)=$P($G(^ORD(101.41,DFIEN,0)),U,4)
     25 .;If mental health check if a GAF score and if MH test is required
     26 .I DPCE="MH",DFIEN D
     27 ..I $P($G(^YTT(601,DFIEN,0)),U)="GAF" S $P(ORY(OCNT),U,12)=1
     28 ..;Check to see if the MH test is required
     29 ..S $P(ORY(OCNT),U,13)=$S($P($G(^PXRMD(801.41,DITEM,0)),U,18)=1:1,1:0)
     30 Q
     31 ;
     32GUI(IEN) ;Work out prompt type for PCE
     33 Q:IEN="" ""
     34 N SUB S SUB=$P($G(^PXRMD(801.41,IEN,46)),U)
     35 Q:'SUB ""
     36 Q $P($G(^PXRMD(801.42,SUB,0)),U)
     37 ;
     38LOAD(DITEM,DCUR,DTTYP) ;Load dialog questions into array
     39 N DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
     40 N DVIT,NODE,CNT,IDENT
     41 ;DBIA #3110    OR(101.41
     42 ;
     43 ;Build list of PCE codes
     44 S DARRAY("AUTTEDT(")="PED"
     45 S DARRAY("AUTTEXAM(")="XAM"
     46 S DARRAY("AUTTHF(")="HF"
     47 S DARRAY("AUTTIMM(")="IMM"
     48 S DARRAY("AUTTSK(")="SK"
     49 ;
     50 S DARRAY("GMRD(120.51,")="VIT"
     51 S DARRAY("ORD(101.41,")="Q"
     52 S DARRAY("YTT(601,")="MH"
     53 ;
     54 S DARRAY("ICD9(")="POV"
     55 S DARRAY("ICPT(")="CPT"
     56 S DARRAY("WV(790.404,")="WH"
     57 S DARRAY("WV(790.1,")="WHR"
     58 ;
     59 S DARRAY("PXD(811.2,")="T"
     60 ;
     61 ;Get the dialog element
     62 S OCNT=0
     63 N TERMNODE,TERMSTAT,TERMOUT
     64 S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4)
     65 ;Finding detail
     66 S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
     67 S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
     68 ;check for WH finding
     69 I $P($G(^PXRMD(801.41,DITEM,0)),U,16)["WHR" S DFIND=$G(WHFIND)
     70 ;
     71 S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
     72 S DPCE="",DVIT="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
     73 ;Exclude from P/N
     74 S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
     75 ;
     76 ;Non taxonomy codes (3 - finding record)
     77 I DPCE'="T" D FREC(DFIEN,DFTYP)
     78 ;
     79 ;Taxonomy codes need expanding (3 - finding record)
     80 I DPCE="T" D EXP^PXRMDLLB(DFIEN,DCUR,DTTYP)
     81 ;
     82 ;Prompt details (4 - prompt records)
     83 N ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
     84 ;If not a taxonomy get prompts from dialog file
     85 I DPCE'="T" D PROTH(DITEM)
     86 ;Check for MST findings
     87 I (DPCE'="T"),(DFTYP]"") D MST^PXRMDLLB(DFTYP,DFIEN)
     88 ;If taxonomy use finding parameters (CPT/POV)
     89 I DPCE="T" D
     90 .;Quit if finding type not passed
     91 .Q:DTTYP=""
     92 .N RSUB,FNODE
     93 .;Get parameter file node for this finding type
     94 .S FNODE=$O(^PXRMD(801.45,"B",DTTYP,"")) Q:FNODE=""
     95 .;Derive resolution from line ien 1=done 2=done elsewhere
     96 .S RSUB=DCUR+1 I (RSUB<1)!(RSUB>2) Q
     97 .;Get details from 811.5
     98 .D PRTAX(FNODE,RSUB)
     99 ;Return array of type 4 records
     100 S DSEQ=""
     101 F  S DSEQ=$O(ARRAY(DSEQ)) Q:'DSEQ  D
     102 .S OCNT=OCNT+1
     103 .S ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
     104 .S DSSEQ=""
     105 .F  S DSSEQ=$O(ARRAY(DSEQ,DSSEQ)) Q:'DSSEQ  D
     106 ..S OCNT=OCNT+1
     107 ..S ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
     108 ;
     109 ;Get progress note text if defined
     110 I DPCE'="T" D:'DEXC PTXT(DITEM)
     111 ;Additional findings
     112 N FASUB
     113 S FASUB=0
     114 F  S FASUB=$O(^PXRMD(801.41,DITEM,3,FASUB)) Q:'FASUB  D
     115 .S DFIND=$P($G(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
     116 .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2) Q:DFTYP=""  Q:DFIEN=""
     117 .S DVIT="",DPCE=$G(DARRAY(DFTYP))
     118 .I DPCE'="" D FREC(DFIEN,DFTYP)
     119 Q
     120 ;
     121 ;
     122 ;Returns item name
     123NAME(DFIEN,DFTYP) ;
     124 Q:DFTYP="" ""
     125 Q:DFIEN="" ""
     126 N NAME,FGLOB,POSN
     127 ;DBIA #4108
     128 I DFTYP="WV(790.404," S NAME=$P($G(^WV(790.404,DFIEN,0)),U) Q:NAME]"" NAME
     129 I DFTYP="WV(790.1," S NAME=$G(WHNAME) K WHNAME Q:NAME]"" NAME
     130 S POSN=2
     131 S:DFTYP["AUTT" POSN=1 S:DFTYP["AUTTEDT" POSN=4 S:DFTYP["ICD" POSN=3
     132 S FGLOB=U_DFTYP_DFIEN_",0)",NAME=$P($G(@FGLOB),U,POSN)
     133 I (POSN>1),NAME="" S NAME=$P($G(@FGLOB),U)
     134 I NAME="" S NAME=DFIEN
     135 Q NAME
     136 ;
     137PROTH(IEN) ; Additional prompts defined in 801.41
     138 N DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
     139 N DTXT,DTYP,PRINT
     140 S DSEQ=0
     141 F  S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",DSEQ)) Q:'DSEQ  D
     142 .;Get prompts in sequence
     143 .S DSUB=$O(^PXRMD(801.41,IEN,10,"B",DSEQ,"")) Q:'DSUB
     144 .;Prompt ien
     145 .S DIEN=$P($G(^PXRMD(801.41,IEN,10,DSUB,0)),U,2) Q:'DIEN
     146 .;Ignore disabled components, and those that are not prompts
     147 .Q:($P($G(^PXRMD(801.41,DIEN,0)),U,3)]"")!("PF"'[$P($G(^(0)),U,4))
     148 .;Set defaults to null
     149 .S DDEF="",DEXC="",DREQ="",DSNL=""
     150 .;Prompt name and GUI process (quit if null)
     151 .S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U),DGUI=$$GUI(DIEN)
     152 .I $G(DGUI)="WH_NOT_PURP" D
     153 ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
     154 .;Type Prompt or Forced
     155 .S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
     156 .I "PF"[DTYP D
     157 ..;Required/Prompt caption
     158 ..S DDATA=$G(^PXRMD(801.41,DIEN,2)),DTXT=$P(DDATA,U,4)
     159 ..;Default value or forced value
     160 ..S:DTYP="P" DDEF=$P(DDATA,U) S:DTYP="F" DDEF=$P(DDATA,U,2)
     161 ..;Override caption/start new line/exclude PN from dialog file
     162 ..S DDATA=$G(^PXRMD(801.41,IEN,10,DSUB,0)),DREQ=$P(DDATA,U,9)
     163 ..S DOVR=$P(DDATA,U,6),DSNL=$P(DDATA,U,7),DEXC=$P(DDATA,U,8)
     164 ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
     165 ..;Convert date to fileman format
     166 ..I DGUI="VST_DATE",DDEF["T" S DDEF=$$DT^XLFDT()
     167 .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_$G(DFTEXT)_U_$G(PRINT)
     168 .;the following section add a comment prompt to the WH review of result
     169 .;section of the reminder dialog
     170 .I DGUI="WH_PAP_RESULT",DFTYP="WV(790.1,",DTYP="P" D
     171 ..N WHCNT,WHFLAG,WHNUM,WHLOOP
     172 ..S WHNUM=DSEQ+1,WHLOOP=0
     173 ..F WHLOOP=0 D
     174 ...S (WHCNT,WHFLAG)=0
     175 ...F  S WHCNT=$O(^PXRMD(801.41,IEN,10,"B",WHCNT)) Q:'WHCNT!(WHFLAG=1)  D
     176 ....I WHCNT=WHNUM S WHFLAG=1,WHNUM=WHNUM+1
     177 ...I WHFLAG=0 S WHLOOP=1
     178 ..S ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
     179 .;Additional checkboxes
     180 .I DGUI="COM",DIEN>1 D
     181 ..N DSSEQ,DSUB,DTEXT
     182 ..S DSSEQ=0
     183 ..F  S DSSEQ=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ)) Q:'DSSEQ  D
     184 ...S DSUB=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ,"")) Q:'DSUB
     185 ...S DTEXT=$P($G(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2) Q:DTEXT=""
     186 ...S ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
     187 Q
     188 ;
     189PRTAX(FNODE,RSUB) ;Get all additional fields for this resolution type
     190 N ACNT,ASUB
     191 N DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
     192 S ASUB=0,DSEQ=0
     193 F  S ASUB=$O(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB)) Q:'ASUB  D
     194 .S DDATA=$G(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0)) Q:DDATA=""
     195 .;Ignore if disabled
     196 .I $P(DDATA,U,3)=1 Q
     197 .S DSUB=$P(DDATA,U) Q:DDATA=""
     198 .S DSEQ=DSEQ+1
     199 .;Set defaults to null
     200 .S DDEF="",DEXC="",DREQ="",DSNL=""
     201 .;Prompt name and GUI process (quit if null)
     202 .S DNAME=$P($G(^PXRMD(801.41,DSUB,0)),U),DGUI=$$GUI(DSUB)
     203 .I $G(DGUI)="WH_NOT_PURP" D
     204 ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
     205 .;Type Prompt or Forced
     206 .S DTYP=$P($G(^PXRMD(801.41,DSUB,0)),U,4)
     207 .I DTYP="P" D
     208 ..S DREQ=$P(DDATA,U,2),DTXT=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
     209 ..;Override caption/start new line/exclude from PN from finding type
     210 ..S DOVR=$P(DDATA,U,5),DSNL=$P(DDATA,U,6),DEXC=$P(DDATA,U,7)
     211 ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
     212 ..;Required/Prompt caption
     213 ..S DDATA=$G(^PXRMD(801.41,DSUB,2))
     214 .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$G(PRINT)
     215 Q
     216 ;
     217PTXT(ITEM) ;Get progress note (WP) text for type 6 records
     218 N ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
     219 S SUB=0
     220 F  S SUB=$O(^PXRMD(801.41,ITEM,35,SUB)) Q:'SUB  D
     221 .S ARRAY(SUB)=$G(^PXRMD(801.41,ITEM,35,SUB,0))
     222 S SUB=0,LAST=0 F  S SUB=$O(ARRAY(SUB)) Q:'SUB  D
     223 .S TEXT=$G(ARRAY(SUB))
     224 .S NULL=0 I (TEXT="")!($E(TEXT)=" ") S NULL=1
     225 .I LAST,'NULL S TEXT="<br>"_TEXT
     226 .S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
     227 .S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
     228 .S OCNT=OCNT+1,ORY(OCNT)=6_U_ITEM_U_U_TEXT
     229 Q
     230 ;
     231TOK(TIEN,TYPE) ;Check if selectable codes exist
     232 N DATA,FOUND,SUB
     233 S FOUND=0,SUB=0
     234 F  S SUB=$O(^PXD(811.2,TIEN,TYPE,SUB)) Q:'SUB  D  Q:FOUND
     235 .S DATA=$G(^PXD(811.2,TIEN,TYPE,SUB,0)) Q:DATA=""
     236 .;Ignore disabled codes
     237 .I '$P(DATA,U,3) S FOUND=1
     238 Q FOUND
Note: See TracChangeset for help on using the changeset viewer.