Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDBL3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDBL3.m
r613 r623 1 PXRMDBL3 ; SLC/PJH - Reminder Dialog Generation. (overflow) ;11/08/20072 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 4 5 6 7 START ;8 D SETSTART^PXRMCOPY("^PXRMD(801.41,") 9 ;Update dialog file for individual dialog items 10 D UPDATE(.ARRAY,.WPTXT,"E") 11 ;Create reminder dialog 12 D UPDATE(.DSET,"","R") 13 ; 14 W !!,"Dialog build complete" H 3 15 END Q 16 ; 17 ;Error Handler 18 ;------------- 19 ERR(DESC) ; 20 N ERROR,IC,REF 21 S ERROR(1)="Unable to update dialog file : "_DESC 22 S ERROR(2)="Error in UPDATE^DIE, needs further investigation" 23 ;Move MSG into ERROR 24 S REF="MSG" 25 F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF 26 ;Screen message 27 D BMES^XPDUTL(.ERROR) 28 Q 29 ; 30 ;Check if dialog element already exists 31 ;-------------------------------------- 32 EXISTS(NAME) ; 33 N IEN S IEN=$O(^PXRMD(801.41,"B",NAME,"")) 34 I IEN S DSET(1,CNT*5)=IEN Q 1 35 Q 0 36 ; 37 ;Update edit history 38 ;------------------- 39 HIS(IENN) ; 40 ;First delete any existing history entries. 41 N ENTRY,IND,IENS,FDA,FDAIEN,MSG,WP 42 S ENTRY="^PXRMD(801.41,"_IENN_",110)" 43 S IND=0 44 F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D 45 . S IENS=IND_","_IENN_","46 . S FDA(801.44,IENS,.01)="@" 47 I $D(FDA(801.44)) D 48 .D FILE^DIE("K","FDA","MSG") I $D(MSG) D AWRITE^PXRMUTIL("MSG") 49 ;Establish an initial entry in the edit history. 50 K FDA,MSG 51 S IENS="+1,"_IENN_"," 52 S FDAIEN(IENN)=IENN 53 S FDA(801.44,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")54 S FDA(801.44,IENS,1)=$$GET1^DIQ(200,DUZ,.01) 55 S FDA(801.44,IENS,2)="WP(1,1)"56 S WP(1,1,1)="Autogenerated" 57 D UPDATE^DIE("E","FDA","FDAIEN","MSG")58 I $D(MSG) D AWRITE^PXRMUTIL("MSG") 59 Q 60 ; 61 ;Mental Health 62 ;------------- 63 MHOK(IEN) ; 64 N RNAME,TEST,YT S YT="" 65 ;Convert ien to name 66 ;DBIA #5044 67 S YT("CODE")=$P($G(^YTT(601.71,IEN,0)),U) 68 ;Quit if no code found 69 I YT("CODE")=""Q 070 I '$$OK^PXRMDLL(IEN) Q 0 71 ;Check if valid 72 ;I TEST(1)["[ERROR]" Q 0 73 ; 74 S DNAME=FTYP_" "_YT("CODE") 75 ;Create arrays 76 S CNT=CNT+1 77 ;Convert dialog item name to UC 78 S DNAME=$TR(DNAME,LOWER,UPPER) 79 ;Truncate the item name - without finesse 80 S DSHORT=DNAME 81 I $L(DSHORT)>40 S DSHORT=$E(DNAME,1,40) 82 ;Dialog item name, finding item and result 83 S ARRAY(CNT)=DSHORT_U_U_RESN_U 84 ;Commented out Result Group Patch 6 until a decision can be made 85 86 ;S RNAME="PXRM "_YT("CODE")_" RESULT GROUP"87 88 ;S $P(ARRAY(CNT),U,7)=$O(^PXRMD(801.41,"B",RNAME,""))89 90 91 92 93 94 95 96 97 98 99 UPDATE(INP,WPTXT,DTYPE) 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 ..;S:$P(INP(CNT),U,7) FDA(801.41,"?+1,",55)=$P(INP(CNT),U,7)133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 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
Note:
See TracChangeset
for help on using the changeset viewer.
