[623] | 1 | PXRMDBL3 ; SLC/PJH - Reminder Dialog Generation. (overflow) ;04/30/2001
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
| 3 | ;
|
---|
| 4 | ; Called from PXRMDBL1
|
---|
| 5 | ;
|
---|
| 6 | ;Set number range for site
|
---|
| 7 | START D SETSTART^PXRMCOPY("^PXRMD(801.41,")
|
---|
| 8 | ;Update dialog file for individual dialog items
|
---|
| 9 | D UPDATE(.ARRAY,.WPTXT,"E")
|
---|
| 10 | ;Create reminder dialog
|
---|
| 11 | D UPDATE(.DSET,"","R")
|
---|
| 12 | ;
|
---|
| 13 | W !!,"Dialog build complete" H 3
|
---|
| 14 | END Q
|
---|
| 15 | ;
|
---|
| 16 | ;Error Handler
|
---|
| 17 | ;-------------
|
---|
| 18 | ERR(DESC) ;
|
---|
| 19 | N ERROR,IC,REF
|
---|
| 20 | S ERROR(1)="Unable to update dialog file : "_DESC
|
---|
| 21 | S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
|
---|
| 22 | ;Move MSG into ERROR
|
---|
| 23 | S REF="MSG"
|
---|
| 24 | F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
|
---|
| 25 | ;Screen message
|
---|
| 26 | D BMES^XPDUTL(.ERROR)
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | ;Check if dialog element already exists
|
---|
| 30 | ;--------------------------------------
|
---|
| 31 | EXISTS(NAME) ;
|
---|
| 32 | N IEN S IEN=$O(^PXRMD(801.41,"B",NAME,""))
|
---|
| 33 | I IEN S DSET(1,CNT*5)=IEN Q 1
|
---|
| 34 | Q 0
|
---|
| 35 | ;
|
---|
| 36 | ;Update edit history
|
---|
| 37 | ;-------------------
|
---|
| 38 | HIS(IENN) ;
|
---|
| 39 | ;First delete any existing history entries.
|
---|
| 40 | N ENTRY,IND,IENS,FDA,FDAIEN,MSG,WP
|
---|
| 41 | S ENTRY="^PXRMD(801.41,"_IENN_",110)"
|
---|
| 42 | S IND=0
|
---|
| 43 | F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
|
---|
| 44 | . S IENS=IND_","_IENN_","
|
---|
| 45 | . S FDA(801.44,IENS,.01)="@"
|
---|
| 46 | I $D(FDA(801.44)) D
|
---|
| 47 | .D FILE^DIE("K","FDA","MSG") I $D(MSG) D AWRITE^PXRMUTIL("MSG")
|
---|
| 48 | ;Establish an initial entry in the edit history.
|
---|
| 49 | K FDA,MSG
|
---|
| 50 | S IENS="+1,"_IENN_","
|
---|
| 51 | S FDAIEN(IENN)=IENN
|
---|
| 52 | S FDA(801.44,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
|
---|
| 53 | S FDA(801.44,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
|
---|
| 54 | S FDA(801.44,IENS,2)="WP(1,1)"
|
---|
| 55 | S WP(1,1,1)="Autogenerated"
|
---|
| 56 | D UPDATE^DIE("E","FDA","FDAIEN","MSG")
|
---|
| 57 | I $D(MSG) D AWRITE^PXRMUTIL("MSG")
|
---|
| 58 | Q
|
---|
| 59 | ;
|
---|
| 60 | ;Mental Health
|
---|
| 61 | ;-------------
|
---|
| 62 | MHOK(IEN) ;
|
---|
| 63 | N RNAME,TEST,YT S YT=""
|
---|
| 64 | ;Convert ien to name
|
---|
| 65 | S YT("CODE")=$P($G(^YTT(601,IEN,0)),U)
|
---|
| 66 | ;Quit if no code found
|
---|
| 67 | I YT("CODE")="" Q 0
|
---|
| 68 | ;Check if this is an allowable GUI test
|
---|
| 69 | I (YT("CODE")'="GAF"),($P($G(^YTT(601.6,IEN,0)),U,4)'="Y") Q 0
|
---|
| 70 | ;Get details of test
|
---|
| 71 | D SHOWALL^YTAPI3(.TEST,.YT)
|
---|
| 72 | ;Check if valid
|
---|
| 73 | I TEST(1)["[ERROR]" Q 0
|
---|
| 74 | ;
|
---|
| 75 | S DNAME=FTYP_" "_YT("CODE")
|
---|
| 76 | ;Create arrays
|
---|
| 77 | S CNT=CNT+1
|
---|
| 78 | ;Convert dialog item name to UC
|
---|
| 79 | S DNAME=$TR(DNAME,LOWER,UPPER)
|
---|
| 80 | ;Truncate the item name - without finesse
|
---|
| 81 | S DSHORT=DNAME
|
---|
| 82 | I $L(DSHORT)>40 S DSHORT=$E(DNAME,1,40)
|
---|
| 83 | ;Dialog item name, finding item and result
|
---|
| 84 | S ARRAY(CNT)=DSHORT_U_U_RESN_U
|
---|
| 85 | ;Result group name
|
---|
| 86 | S RNAME="PXRM "_YT("CODE")_" RESULT GROUP"
|
---|
| 87 | ;Result pointer
|
---|
| 88 | S $P(ARRAY(CNT),U,7)=$O(^PXRMD(801.41,"B",RNAME,""))
|
---|
| 89 | ;If aims exclude from p/n
|
---|
| 90 | I YT("CODE")="AIMS" S $P(ARRAY(CNT),U,6)=1
|
---|
| 91 | ;Prompt text
|
---|
| 92 | S WPTXT(CNT,1)=YT("CODE")_" (Mental Health Instrument)"
|
---|
| 93 | ;test
|
---|
| 94 | W !!,CNT,?5,WPTXT(CNT,1)
|
---|
| 95 | Q 1
|
---|
| 96 | ;
|
---|
| 97 | ;Sub-routine to update dialog file #801.41
|
---|
| 98 | ;-----------------------------------------
|
---|
| 99 | UPDATE(INP,WPTXT,DTYPE) ;
|
---|
| 100 | N CNT,DATA,DESC,IEN,STRING,SUB,TEXT
|
---|
| 101 | N FDA,FDAIEN,MSG
|
---|
| 102 | ;Get each dialog line in turn
|
---|
| 103 | S STRING="Updating "_$S(DTYPE="E":"Dialog Elements",1:"Reminder Dialog")
|
---|
| 104 | D BMES^XPDUTL(STRING)
|
---|
| 105 | ;
|
---|
| 106 | ;Create FDA for each entry in array
|
---|
| 107 | S CNT=""
|
---|
| 108 | F S CNT=$O(INP(CNT)) Q:CNT="" D Q:$D(MSG)
|
---|
| 109 | .;If finding is a finding item parameter no need to build an element
|
---|
| 110 | .I DTYPE="E",$P(INP(CNT),U)=801.43 D Q
|
---|
| 111 | ..S DSET(1,CNT)=$P(INP(CNT),U,2)
|
---|
| 112 | .;Build FDA array
|
---|
| 113 | .K FDAIEN,FDA
|
---|
| 114 | .;If existing element and not in replace mode don't update FDA
|
---|
| 115 | .I DTYPE="E",'PXRMREPL Q:$$EXISTS($P(INP(CNT),U))
|
---|
| 116 | .;Name
|
---|
| 117 | .S FDA(801.41,"?+1,",.01)=$P(INP(CNT),U)
|
---|
| 118 | .;Dialog type
|
---|
| 119 | .S FDA(801.41,"?+1,",4)=DTYPE
|
---|
| 120 | .;Class
|
---|
| 121 | .S FDA(801.41,"?+1,",100)="L"
|
---|
| 122 | .;Sponsor
|
---|
| 123 | .S FDA(801.41,"?+1,",101)=""
|
---|
| 124 | .;Prompt text/finding entries
|
---|
| 125 | .I DTYPE="E" D
|
---|
| 126 | ..S FDA(801.41,"?+1,",13)=$P(INP(CNT),U,2)
|
---|
| 127 | ..S FDA(801.41,"?+1,",15)=$P(INP(CNT),U,3)
|
---|
| 128 | ..S FDA(801.41,"?+1,",17)=$P(INP(CNT),U,4)
|
---|
| 129 | ..S FDA(801.41,"?+1,",25)="WPTXT("_CNT_")"
|
---|
| 130 | ..;MH fields (exclude from P/N and results pointer)
|
---|
| 131 | ..S:$P(INP(CNT),U,6) FDA(801.41,"?+1,",54)=$P(INP(CNT),U,6)
|
---|
| 132 | ..S:$P(INP(CNT),U,7) FDA(801.41,"?+1,",55)=$P(INP(CNT),U,7)
|
---|
| 133 | .;Reminder dialog associated reminder/DISABLE
|
---|
| 134 | .I DTYPE="R" D
|
---|
| 135 | ..S FDA(801.41,"?+1,",2)=REM
|
---|
| 136 | ..I PXRMENAB'="Y" S FDA(801.41,"?+1,",3)="DISABLED AT AUTO GENERATE"
|
---|
| 137 | .;Dialog items point to prompts and actions, Sets point to dialog items
|
---|
| 138 | .N ACNT,SUB
|
---|
| 139 | .;S ACNT=0,SUB=2
|
---|
| 140 | .S ACNT=0,SUB=1
|
---|
| 141 | .F S ACNT=$O(INP(CNT,ACNT)) Q:ACNT="" D
|
---|
| 142 | ..S SUB=SUB+1,FDA(801.412,"?+"_SUB_",?+1,",.01)=ACNT
|
---|
| 143 | ..S FDA(801.412,"?+"_SUB_",?+1,",2)=$P(INP(CNT,ACNT),U)
|
---|
| 144 | ..S FDA(801.412,"?+"_SUB_",?+1,",6)=$P(INP(CNT,ACNT),U,2)
|
---|
| 145 | ..S FDA(801.412,"?+"_SUB_",?+1,",7)=$P(INP(CNT,ACNT),U,3)
|
---|
| 146 | ..S FDA(801.412,"?+"_SUB_",?+1,",8)=$P(INP(CNT,ACNT),U,4)
|
---|
| 147 | ..S FDA(801.412,"?+"_SUB_",?+1,",9)=$P(INP(CNT,ACNT),U,5)
|
---|
| 148 | .;Update #801.41
|
---|
| 149 | .D UPDATE^DIE("","FDA","FDAIEN","MSG")
|
---|
| 150 | .I $D(MSG) D ERR($G(INP(CNT))) Q
|
---|
| 151 | .;Save IEN of dialog created/used for later use in building dialog set
|
---|
| 152 | .I DTYPE="E" S DSET(1,CNT*5)=FDAIEN(1)
|
---|
| 153 | .;Insert link to reminder
|
---|
| 154 | .I DTYPE="R",PXRMLINK="Y" D
|
---|
| 155 | ..S $P(^PXD(811.9,REM,51),U)=FDAIEN(1),^PXD(811.9,"AG",FDAIEN(1),REM)=""
|
---|
| 156 | .;Update Edit History
|
---|
| 157 | .D HIS(FDAIEN(1))
|
---|
| 158 | Q
|
---|