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/PXRMDLL.m

    r613 r623  
    1 PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;09/26/2007
    2         ;;2.0;CLINICAL REMINDERS;**10,6**;Feb 04, 2005;Build 123
    3         ;
    4 OK(DIEN)        ;Check if mental health test is for GUI
    5         I 'DIEN Q 0
    6         Q $$MH^PXRMDLG5(DIEN)
    7         ;
    8 TXT     ;Format text
    9         N NULL
    10         S TEXT=DTXT(SUB),NULL=0
    11         I ($E(TEXT)=" ")!(TEXT="") S NULL=1
    12         I LAST,'NULL S TEXT="<br>"_TEXT
    13         S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
    14         S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
    15         Q
    16         ;
    17 EXP(TIEN,DITEM,DSUB)    ;Expand taxonomy codes
    18         N ACNT,AHIS,ATYP,ARRAY,CODES,CNT,DPCE,DTAX
    19         ;Get taxonomy file details
    20         D TAX(TIEN,.ARRAY)
    21         ;
    22         ;Build dialog from the returned array
    23         ;
    24         ;Main Taxonomy prompt
    25         S DTXT=ARRAY
    26         S OCNT=OCNT+1
    27         S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
    28         ;Default group indents and selection entry
    29         S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=2
    30         S OCNT=OCNT+1
    31         S ORY(OCNT)=2_U_DITEM_U_DSUB_U_DTXT
    32         ;
    33         ;Taxonomy CPT/POV resolution prompts
    34         S ACNT=""
    35         F  S ACNT=$O(ARRAY(ACNT)) Q:ACNT=""  D
    36         .;Prompt text
    37         .S DTXT=$P(ARRAY(ACNT),U),DPCE=$P(ARRAY(ACNT),U,4)
    38         .;Historical/Current flag
    39         .S AHIS=0 I $P(ARRAY(ACNT),U,3)=2 S AHIS=1
    40         .;CPT/POV
    41         .S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
    42         .;Initial display
    43         .S DHIDE=0,DCHECK=0,DDIS=0
    44         .;Construct ien for this level
    45         .S DTAX=DSUB_"."_ACNT
    46         .S OCNT=OCNT+1
    47         .S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
    48         .S OCNT=OCNT+1
    49         .S ORY(OCNT)=2_U_DITEM_U_DTAX_U_DTXT
    50         Q
    51         ;
    52 GROUP(DIEN,DSUB)        ;Dialog group
    53         N DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
    54         N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT
    55         ;Group caption text
    56         S DATA=$G(^PXRMD(801.41,DIEN,0))
    57         S DCAP=$P(DATA,U,5),DBOX=$P(DATA,U,6),DIND=$P(DATA,U,7)
    58         S DSHARE=$P(DATA,U,8),DENTRY=$P(DATA,U,9),DHIDE=$P(DATA,U,10)
    59         S DINDPN=$P(DATA,U,12) S:DINDPN="" DINDPN=0
    60         S DBOX=$S(DBOX="Y":1,1:"")
    61         ;group header is display only if SUPPRESS CHECKBOX
    62         S DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
    63         ;Default group setting to hide
    64         I DHIDE="" S DHIDE=1
    65         ;
    66         S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
    67         ;
    68         S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
    69         S $P(ORY(OCNT),U,8)=$$AHIS(DIEN)
    70         S $P(ORY(OCNT),U,15)=DHIDE,$P(ORY(OCNT),U,16)=DIND
    71         S $P(ORY(OCNT),U,17)=DSHARE,$P(ORY(OCNT),U,18)=DENTRY
    72         S $P(ORY(OCNT),U,19)=DBOX,$P(ORY(OCNT),U,20)=DCAP
    73         S $P(ORY(OCNT),U,21)=DINDPN
    74         ;Create type 2 records if if here is additional group text
    75         N LAST,TEXT
    76         S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
    77         .D TXT
    78         .S OCNT=OCNT+1,ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
    79         ;Get dialog group sub-elements
    80         N DTYP,DSUPP,DDIS,IDENT S DGSEQ=0
    81         F  S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ  D
    82         .S DGSUB=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ,"")) Q:'DGSUB
    83         .S DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0))
    84         .S DGIEN=$P(DATA,U,2) Q:'DGIEN
    85         .;Branching logic call to determine if element should be suppress,
    86         .;replace or left as is
    87         .N TERMNODE,TERMSTAT
    88         .S TERMNODE=$G(^PXRMD(801.41,DGIEN,49))
    89         .I $G(TERMNODE)'="" D  Q:TERMSTAT=0
    90         ..S TERMSTAT=1
    91         ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DGIEN,.DATA,.TERMSTAT)
    92         .;Exclude from P/N
    93         .S DEXC=$P(DATA,U,8)
    94         .I $P($G(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR" D
    95         ..K DTXT S SUB=0 F  S SUB=$O(^PXRMD(801.41,DGIEN,25,SUB)) Q:'SUB  D
    96         ...S DTXT(SUB)=$G(^PXRMD(801.41,DGIEN,25,SUB,0))
    97         .;Check if element is disabled/invalid
    98         .S DATA=$G(^PXRMD(801.41,DGIEN,0)) Q:DATA=""  Q:$P(DATA,U,3)]""
    99         .;If the actual element is exclude from P/N override
    100         .I $P($G(^PXRMD(801.41,DGIEN,2)),U,3) S DEXC=1
    101         .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11) Q:"EG"'[DTYP
    102         .S DMHEX=$P(DATA,U,14)
    103         .S DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
    104         .;S DRESL=$P(DATA,U,15)
    105         .S DRES=$P($G(^PXRMD(801.41,DGIEN,1)),U,3)
    106         .;Done Elsewhere (historical)
    107         .S DHIS=$$AHIS(DGIEN)
    108         .S DFIND=$P($G(^PXRMD(801.41,DGIEN,1)),U,5)
    109         .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
    110         .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
    111         .;If mental Health ignore if not GUI
    112         .I DPCE="MH" Q:'$$OK(DFIEN)
    113         .S DGRP=DSUB_"."_DGSUB
    114         .;Taxonomy codes need expanding
    115         .I DPCE="T" D EXP(DFIEN,DGIEN,DGRP) Q
    116         .;Translate vitals ien to PCE code - This will need a DBIA
    117         .I DPCE="VIT" S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
    118         .;Embedded Dialog Group
    119         .I DTYP="G" D GROUP(DGIEN,DGRP) Q
    120         .S DDIS="S" I DSUPP=1 S DDIS="D"
    121         .S DGRP=DSUB_"."_DGSUB,OCNT=OCNT+1
    122         .S ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$G(DCOUNT)
    123         .;
    124         .N LAST,TEXT
    125         .S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
    126         ..D TXT
    127         ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
    128         Q
    129         ;
    130 LOAD(DIEN,DFN)  ;Load dialog questions into array
    131         N DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
    132         N DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT
    133         ;Check Status of dialog
    134         S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
    135         ;If disabled ignore
    136         I $P(DATA,U,3)]"" Q
    137         ;Ignore if not a reminder dialog
    138         I $P(DATA,U,4)'="R" Q
    139         ;
    140         ;List of PCE codes
    141         S DARRAY("AUTTEDT(")="PED"
    142         S DARRAY("AUTTEXAM(")="XAM"
    143         S DARRAY("AUTTHF(")="HF"
    144         S DARRAY("AUTTIMM(")="IMM"
    145         S DARRAY("AUTTSK(")="SK"
    146         S DARRAY("GMRD(120.51,")="VIT"
    147         S DARRAY("ORD(101.41,")="Q"
    148         S DARRAY("YTT(601.71,")="MH"
    149         S DARRAY("ICD9(")="POV"
    150         S DARRAY("ICPT(")="CPT"
    151         S DARRAY("PXD(811.2,")="T"
    152         S DARRAY("WV(790.1,")="WHR"
    153         ;
    154         ;Get elements for the dialog
    155         S DSEQ=0,OCNT=0
    156         F  S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ  D
    157         .S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
    158         .S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
    159         .S DITEM=$P(DATA,U,2) Q:DITEM=""
    160         .;Ignore disabled elements
    161         .S DATA=$G(^PXRMD(801.41,DITEM,0)) Q:DATA=""  Q:$P(DATA,U,3)]""
    162         .;Branching logic call to determine if element should be suppress,
    163         .;replace or left as is
    164         .S TERMNODE=$G(^PXRMD(801.41,DITEM,49))
    165         .N TERMSTAT
    166         .I $G(TERMNODE)'="" D  Q:TERMSTAT=0
    167         ..S TERMSTAT=1
    168         ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DITEM,.DATA,.TERMSTAT)
    169         .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11)
    170         .S DMHEX=$P(DATA,U,14)
    171         .S DRESL=$$RESGROUP^PXRMDLLB(DITEM)
    172         .;S DRESL=$P(DATA,U,15)
    173         .K DTXT S SUB=0
    174         .F  S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB  D
    175         ..S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
    176         .S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
    177         .S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
    178         .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
    179         .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
    180         .;If mental Health ignore if not GUI
    181         .I DPCE="MH" Q:'$$OK(DFIEN)
    182         .;Exclude from PN
    183         .S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
    184         .;Taxonomy codes need expanding
    185         .I DPCE="T" D EXP(DFIEN,DITEM,DSUB) Q
    186         .;Translate vitals ien to PCE code - This will need a DBIA
    187         .I DPCE="VIT" S DFIEN=$P($G(^GMRD(120.51,DFIEN,0)),U,7)
    188         .;Done Elsewhere (historical)
    189         .S DHIS=$$AHIS(DITEM)
    190         .;Dialog Group
    191         .I DTYP="G" D GROUP(DITEM,DSUB) Q
    192         .;Dialog type/text and resolution
    193         .S OCNT=OCNT+1,DDIS="S"
    194         .I DSUPP=1 S DDIS="D"
    195         .S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
    196         .N LAST,TEXT
    197         .S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
    198         ..D TXT
    199         ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
    200         Q
    201         ;
    202 TAX(TXIEN,ARRAY)        ;Return list of resolutions/codes for taxonomy
    203         N CNT,DTXT,FNODE,RSUB,TDX,TNAME,TPAR,TPR,TYP
    204         N TCUR,TDTXT,TDHTXT,THIS,TPTXT,TPHTXT
    205         ;
    206         ;Get taxonomy name
    207         S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1)
    208         ;
    209         ;Check what type of taxonomy codes exist
    210         S TDX=$$TOK^PXRMDLLA(TXIEN,"SDX")
    211         S TPR=$$TOK^PXRMDLLA(TXIEN,"SPR")
    212         ;
    213         ;Taxonomy dialog text
    214         S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,3)
    215         ;default to taxonomy description if null
    216         I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,2)
    217         ;default to taxonomy name if null
    218         I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,1)
    219         ;
    220         S CNT=0,ARRAY=DTXT
    221         ;
    222         ;Diagnoses
    223         I TDX D
    224         .;Diagnosis texts
    225         .S TPAR=$G(^PXD(811.2,TXIEN,"SDZ"))
    226         .;Get parameter file node for this finding type
    227         .S FNODE=$O(^PXRMD(801.45,"B","POV","")) Q:FNODE=""
    228         .;check if finding parameters are disabled
    229         .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
    230         .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
    231         .;get category text (diagnoses)
    232         .I 'TCUR D  ; Current
    233         ..S TDTXT=$P(TPAR,U,2) S:TDTXT="" TDTXT=TNAME
    234         ..S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_1_U_"POV"
    235         .I 'THIS D  ; Historical
    236         ..S TDHTXT=$P(TPAR,U,3) S:TDHTXT="" TDHTXT=TNAME_" (HISTORICAL)"
    237         ..S CNT=CNT+1,ARRAY(CNT)=TDHTXT_U_80_U_2_U_"POV"
    238         ;Procedures
    239         I TPR D
    240         .;Procedure texts
    241         .S TPAR=$G(^PXD(811.2,TXIEN,"SPZ"))
    242         .;Get parameter file node for this finding type
    243         .S FNODE=$O(^PXRMD(801.45,"B","CPT","")) Q:FNODE=""
    244         .;check if finding parameters are disabled
    245         .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
    246         .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
    247         .;get category text (procedures)
    248         .I 'TCUR D  ; Current
    249         ..S TPTXT=$P(TPAR,U,2) S:TPTXT="" TPTXT=TNAME
    250         ..S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_1_U_"CPT"
    251         .I 'THIS D  ; Historical
    252         ..S TPHTXT=$P(TPAR,U,3) S:TPHTXT="" TPHTXT=TNAME_" (HISTORICAL)"
    253         ..S CNT=CNT+1,ARRAY(CNT)=TPHTXT_U_81_U_2_U_"CPT"
    254         ;
    255         Q
    256         ;
    257 AHIS(DITEM)     ;
    258         N RSIEN,RSNAM
    259         S RSIEN=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
    260         I RSIEN="" Q 0
    261         S RSNAM=$P($G(^PXRMD(801.9,RSIEN,0)),U)
    262         I RSNAM["DONE ELSEWHERE" Q 1
    263         N GUI,PIEN,PFOUND
    264         S PIEN=0,PFOUND=0
    265         F  S PIEN=$O(^PXRMD(801.41,DITEM,10,"D",PIEN)) Q:'PIEN  D  Q:PFOUND
    266         .;Ignore elements and groups
    267         .I "EG"[$P($G(^PXRMD(801.41,PIEN,0)),U,4) Q
    268         .;GUI Process
    269         .S GUI=$P($G(^PXRMD(801.41,PIEN,46)),U) Q:'GUI
    270         .;Check if this is PXRM VISIT DATE (or a copy of it)
    271         .I $P($G(^PXRMD(801.42,GUI,0)),U)="VST_DATE" S PFOUND=1
    272         Q PFOUND
     1PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;09/26/2007
     2 ;;2.0;CLINICAL REMINDERS;**10**;Feb 04, 2005;Build 25
     3 ;
     4OK(DIEN) ;Check if mental health test is for GUI
     5 I 'DFIEN Q 0
     6 I $P($G(^YTT(601.6,DFIEN,0)),U,4)="Y" Q 1
     7 I $P($G(^YTT(601,DFIEN,0)),U)="GAF" Q 1
     8 Q 0
     9 ;
     10TXT ;Format text
     11 N NULL
     12 S TEXT=DTXT(SUB),NULL=0
     13 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
     14 I LAST,'NULL S TEXT="<br>"_TEXT
     15 S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
     16 S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
     17 Q
     18 ;
     19EXP(TIEN,DITEM,DSUB) ;Expand taxonomy codes
     20 N ACNT,AHIS,ATYP,ARRAY,CODES,CNT,DPCE,DTAX
     21 ;Get taxonomy file details
     22 D TAX(TIEN,.ARRAY)
     23 ;
     24 ;Build dialog from the returned array
     25 ;
     26 ;Main Taxonomy prompt
     27 S DTXT=ARRAY
     28 S OCNT=OCNT+1
     29 S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
     30 ;Default group indents and selection entry
     31 S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=2
     32 S OCNT=OCNT+1
     33 S ORY(OCNT)=2_U_DITEM_U_DSUB_U_DTXT
     34 ;
     35 ;Taxonomy CPT/POV resolution prompts
     36 S ACNT=""
     37 F  S ACNT=$O(ARRAY(ACNT)) Q:ACNT=""  D
     38 .;Prompt text
     39 .S DTXT=$P(ARRAY(ACNT),U),DPCE=$P(ARRAY(ACNT),U,4)
     40 .;Historical/Current flag
     41 .S AHIS=0 I $P(ARRAY(ACNT),U,3)=2 S AHIS=1
     42 .;CPT/POV
     43 .S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
     44 .;Initial display
     45 .S DHIDE=0,DCHECK=0,DDIS=0
     46 .;Construct ien for this level
     47 .S DTAX=DSUB_"."_ACNT
     48 .S OCNT=OCNT+1
     49 .S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
     50 .S OCNT=OCNT+1
     51 .S ORY(OCNT)=2_U_DITEM_U_DTAX_U_DTXT
     52 Q
     53 ;
     54GROUP(DIEN,DSUB) ;Dialog group
     55 N DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
     56 N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT
     57 ;Group caption text
     58 S DATA=$G(^PXRMD(801.41,DIEN,0))
     59 S DCAP=$P(DATA,U,5),DBOX=$P(DATA,U,6),DIND=$P(DATA,U,7)
     60 S DSHARE=$P(DATA,U,8),DENTRY=$P(DATA,U,9),DHIDE=$P(DATA,U,10)
     61 S DINDPN=$P(DATA,U,12) S:DINDPN="" DINDPN=0
     62 S DBOX=$S(DBOX="Y":1,1:"")
     63 ;group header is display only if SUPPRESS CHECKBOX
     64 S DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
     65 ;Default group setting to hide
     66 I DHIDE="" S DHIDE=1
     67 ;
     68 S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
     69 ;
     70 S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
     71 S $P(ORY(OCNT),U,8)=$$AHIS(DIEN)
     72 S $P(ORY(OCNT),U,15)=DHIDE,$P(ORY(OCNT),U,16)=DIND
     73 S $P(ORY(OCNT),U,17)=DSHARE,$P(ORY(OCNT),U,18)=DENTRY
     74 S $P(ORY(OCNT),U,19)=DBOX,$P(ORY(OCNT),U,20)=DCAP
     75 S $P(ORY(OCNT),U,21)=DINDPN
     76 ;Create type 2 records if if here is additional group text
     77 N LAST,TEXT
     78 S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
     79 .D TXT
     80 .S OCNT=OCNT+1,ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
     81 ;Get dialog group sub-elements
     82 N DTYP,DSUPP,DDIS,IDENT S DGSEQ=0
     83 F  S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ  D
     84 .S DGSUB=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ,"")) Q:'DGSUB
     85 .S DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0))
     86 .S DGIEN=$P(DATA,U,2) Q:'DGIEN
     87 .;Branching logic call to determine if element should be suppress,
     88 .;replace or left as is
     89 .N TERMNODE,TERMSTAT
     90 .S TERMNODE=$G(^PXRMD(801.41,DGIEN,49))
     91 .I $G(TERMNODE)'="" D  Q:TERMSTAT=0
     92 ..S TERMSTAT=1
     93 ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DGIEN,.DATA,.TERMSTAT)
     94 .;Exclude from P/N
     95 .S DEXC=$P(DATA,U,8)
     96 .I $P($G(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR" D
     97 ..K DTXT S SUB=0 F  S SUB=$O(^PXRMD(801.41,DGIEN,25,SUB)) Q:'SUB  D
     98 ...S DTXT(SUB)=$G(^PXRMD(801.41,DGIEN,25,SUB,0))
     99 .;Check if element is disabled/invalid
     100 .S DATA=$G(^PXRMD(801.41,DGIEN,0)) Q:DATA=""  Q:$P(DATA,U,3)]""
     101 .;If the actual element is exclude from P/N override
     102 .I $P($G(^PXRMD(801.41,DGIEN,2)),U,3) S DEXC=1
     103 .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11) Q:"EG"'[DTYP
     104 .S DMHEX=$P(DATA,U,14),DRESL=$P(DATA,U,15)
     105 .S DRES=$P($G(^PXRMD(801.41,DGIEN,1)),U,3)
     106 .;Done Elsewhere (historical)
     107 .S DHIS=$$AHIS(DGIEN)
     108 .S DFIND=$P($G(^PXRMD(801.41,DGIEN,1)),U,5)
     109 .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
     110 .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
     111 .;If mental Health ignore if not GUI
     112 .I DPCE="MH" Q:'$$OK(DFIEN)
     113 .S DGRP=DSUB_"."_DGSUB
     114 .;Taxonomy codes need expanding
     115 .I DPCE="T" D EXP(DFIEN,DGIEN,DGRP) Q
     116 .;Translate vitals ien to PCE code - This will need a DBIA
     117 .I DPCE="VIT" S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
     118 .;Embedded Dialog Group
     119 .I DTYP="G" D GROUP(DGIEN,DGRP) Q
     120 .S DDIS="S" I DSUPP=1 S DDIS="D"
     121 .S DGRP=DSUB_"."_DGSUB,OCNT=OCNT+1
     122 .S ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$G(DCOUNT)
     123 .;
     124 .N LAST,TEXT
     125 .S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
     126 ..D TXT
     127 ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
     128 Q
     129 ;
     130LOAD(DIEN,DFN) ;Load dialog questions into array
     131 N DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
     132 N DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT
     133 ;Check Status of dialog
     134 S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
     135 ;If disabled ignore
     136 I $P(DATA,U,3)]"" Q
     137 ;Ignore if not a reminder dialog
     138 I $P(DATA,U,4)'="R" Q
     139 ;
     140 ;List of PCE codes
     141 S DARRAY("AUTTEDT(")="PED"
     142 S DARRAY("AUTTEXAM(")="XAM"
     143 S DARRAY("AUTTHF(")="HF"
     144 S DARRAY("AUTTIMM(")="IMM"
     145 S DARRAY("AUTTSK(")="SK"
     146 S DARRAY("GMRD(120.51,")="VIT"
     147 S DARRAY("ORD(101.41,")="Q"
     148 S DARRAY("YTT(601,")="MH"
     149 S DARRAY("ICD9(")="POV"
     150 S DARRAY("ICPT(")="CPT"
     151 S DARRAY("PXD(811.2,")="T"
     152 S DARRAY("WV(790.1,")="WHR"
     153 ;
     154 ;Get elements for the dialog
     155 S DSEQ=0,OCNT=0
     156 F  S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ  D
     157 .S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
     158 .S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
     159 .S DITEM=$P(DATA,U,2) Q:DITEM=""
     160 .;Ignore disabled elements
     161 .S DATA=$G(^PXRMD(801.41,DITEM,0)) Q:DATA=""  Q:$P(DATA,U,3)]""
     162 .;Branching logic call to determine if element should be suppress,
     163 .;replace or left as is
     164 .S TERMNODE=$G(^PXRMD(801.41,DITEM,49))
     165 .N TERMSTAT
     166 .I $G(TERMNODE)'="" D  Q:TERMSTAT=0
     167 ..S TERMSTAT=1
     168 ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DITEM,.DATA,.TERMSTAT)
     169 .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11)
     170 .S DMHEX=$P(DATA,U,14),DRESL=$P(DATA,U,15)
     171 .K DTXT S SUB=0
     172 .F  S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB  D
     173 ..S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
     174 .S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
     175 .S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
     176 .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
     177 .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
     178 .;If mental Health ignore if not GUI
     179 .I DPCE="MH" Q:'$$OK(DFIEN)
     180 .;Exclude from PN
     181 .S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
     182 .;Taxonomy codes need expanding
     183 .I DPCE="T" D EXP(DFIEN,DITEM,DSUB) Q
     184 .;Translate vitals ien to PCE code - This will need a DBIA
     185 .I DPCE="VIT" S DFIEN=$P($G(^GMRD(120.51,DFIEN,0)),U,7)
     186 .;Done Elsewhere (historical)
     187 .S DHIS=$$AHIS(DITEM)
     188 .;Dialog Group
     189 .I DTYP="G" D GROUP(DITEM,DSUB) Q
     190 .;Dialog type/text and resolution
     191 .S OCNT=OCNT+1,DDIS="S"
     192 .I DSUPP=1 S DDIS="D"
     193 .S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
     194 .N LAST,TEXT
     195 .S SUB=0,LAST=0 F  S SUB=$O(DTXT(SUB)) Q:'SUB  D
     196 ..D TXT
     197 ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
     198 Q
     199 ;
     200TAX(TXIEN,ARRAY) ;Return list of resolutions/codes for taxonomy
     201 N CNT,DTXT,FNODE,RSUB,TDX,TNAME,TPAR,TPR,TYP
     202 N TCUR,TDTXT,TDHTXT,THIS,TPTXT,TPHTXT
     203 ;
     204 ;Get taxonomy name
     205 S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1)
     206 ;
     207 ;Check what type of taxonomy codes exist
     208 S TDX=$$TOK^PXRMDLLA(TXIEN,"SDX")
     209 S TPR=$$TOK^PXRMDLLA(TXIEN,"SPR")
     210 ;
     211 ;Taxonomy dialog text
     212 S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,3)
     213 ;default to taxonomy description if null
     214 I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,2)
     215 ;default to taxonomy name if null
     216 I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,1)
     217 ;
     218 S CNT=0,ARRAY=DTXT
     219 ;
     220 ;Diagnoses
     221 I TDX D
     222 .;Diagnosis texts
     223 .S TPAR=$G(^PXD(811.2,TXIEN,"SDZ"))
     224 .;Get parameter file node for this finding type
     225 .S FNODE=$O(^PXRMD(801.45,"B","POV","")) Q:FNODE=""
     226 .;check if finding parameters are disabled
     227 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
     228 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
     229 .;get category text (diagnoses)
     230 .I 'TCUR D  ; Current
     231 ..S TDTXT=$P(TPAR,U,2) S:TDTXT="" TDTXT=TNAME
     232 ..S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_1_U_"POV"
     233 .I 'THIS D  ; Historical
     234 ..S TDHTXT=$P(TPAR,U,3) S:TDHTXT="" TDHTXT=TNAME_" (HISTORICAL)"
     235 ..S CNT=CNT+1,ARRAY(CNT)=TDHTXT_U_80_U_2_U_"POV"
     236 ;Procedures
     237 I TPR D
     238 .;Procedure texts
     239 .S TPAR=$G(^PXD(811.2,TXIEN,"SPZ"))
     240 .;Get parameter file node for this finding type
     241 .S FNODE=$O(^PXRMD(801.45,"B","CPT","")) Q:FNODE=""
     242 .;check if finding parameters are disabled
     243 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
     244 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
     245 .;get category text (procedures)
     246 .I 'TCUR D  ; Current
     247 ..S TPTXT=$P(TPAR,U,2) S:TPTXT="" TPTXT=TNAME
     248 ..S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_1_U_"CPT"
     249 .I 'THIS D  ; Historical
     250 ..S TPHTXT=$P(TPAR,U,3) S:TPHTXT="" TPHTXT=TNAME_" (HISTORICAL)"
     251 ..S CNT=CNT+1,ARRAY(CNT)=TPHTXT_U_81_U_2_U_"CPT"
     252 ;
     253 Q
     254 ;
     255AHIS(DITEM) ;
     256 N RSIEN,RSNAM
     257 S RSIEN=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
     258 I RSIEN="" Q 0
     259 S RSNAM=$P($G(^PXRMD(801.9,RSIEN,0)),U)
     260 I RSNAM["DONE ELSEWHERE" Q 1
     261 N GUI,PIEN,PFOUND
     262 S PIEN=0,PFOUND=0
     263 F  S PIEN=$O(^PXRMD(801.41,DITEM,10,"D",PIEN)) Q:'PIEN  D  Q:PFOUND
     264 .;Ignore elements and groups
     265 .I "EG"[$P($G(^PXRMD(801.41,PIEN,0)),U,4) Q
     266 .;GUI Process
     267 .S GUI=$P($G(^PXRMD(801.41,PIEN,46)),U) Q:'GUI
     268 .;Check if this is PXRM VISIT DATE (or a copy of it)
     269 .I $P($G(^PXRMD(801.42,GUI,0)),U)="VST_DATE" S PFOUND=1
     270 Q PFOUND
Note: See TracChangeset for help on using the changeset viewer.