PXRMDBL3 ; SLC/PJH - Reminder Dialog Generation. (overflow) ;06/08/2009
;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
;
; Called from PXRMDBL1
;
;Set number range for site
START ;
D SETSTART^PXRMCOPY("^PXRMD(801.41,")
;Update dialog file for individual dialog items
D UPDATE(.ARRAY,.WPTXT,"E")
;Create reminder dialog
D UPDATE(.DSET,"","R")
;
W !!,"Dialog build complete" H 3
END Q
;
;Error Handler
;-------------
ERR(DESC) ;
N ERROR,IC,REF
S ERROR(1)="Unable to update dialog file : "_DESC
S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
;Move MSG into ERROR
S REF="MSG"
F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
;Screen message
D BMES^XPDUTL(.ERROR)
Q
;
;Check if dialog element already exists
;--------------------------------------
EXISTS(NAME) ;
N IEN S IEN=$O(^PXRMD(801.41,"B",NAME,""))
I IEN S DSET(1,CNT*5)=IEN Q 1
Q 0
;
;Update edit history
;-------------------
HIS(IENN) ;
;First delete any existing history entries.
N ENTRY,IND,IENS,FDA,FDAIEN,MSG,WP
S ENTRY="^PXRMD(801.41,"_IENN_",110)"
S IND=0
F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
. S IENS=IND_","_IENN_","
. S FDA(801.44,IENS,.01)="@"
I $D(FDA(801.44)) D
.D FILE^DIE("K","FDA","MSG") I $D(MSG) D AWRITE^PXRMUTIL("MSG")
;Establish an initial entry in the edit history.
K FDA,MSG
S IENS="+1,"_IENN_","
S FDAIEN(IENN)=IENN
S FDA(801.44,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S FDA(801.44,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
S FDA(801.44,IENS,2)="WP(1,1)"
S WP(1,1,1)="Autogenerated"
D UPDATE^DIE("E","FDA","FDAIEN","MSG")
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
Q
;
;Mental Health
;-------------
MHOK(IEN) ;
N DSHORT,RNAME,TEST,YT S YT=""
;Convert ien to name
;DBIA #5044
S YT("CODE")=$P($G(^YTT(601.71,IEN,0)),U)
;Quit if no code found
I YT("CODE")="" Q 0
I '$$OK^PXRMDLL(IEN) Q 0
;Check if valid
;I TEST(1)["[ERROR]" Q 0
;
S DNAME=FTYP_" "_YT("CODE")
;Create arrays
S CNT=CNT+1
;Convert dialog item name to UC
S DNAME=$TR(DNAME,LOWER,UPPER)
;Truncate the item name - without finesse
S DSHORT=DNAME
I $L(DSHORT)>40 S DSHORT=$E(DNAME,1,40)
;Dialog item name, finding item and result
S ARRAY(CNT)=DSHORT_U_U_RESN_U
;Commented out Result Group Patch 6 until a decision can be made
;Result group name
;S RNAME="PXRM "_YT("CODE")_" RESULT GROUP"
;Result pointer
;S $P(ARRAY(CNT),U,7)=$O(^PXRMD(801.41,"B",RNAME,""))
;If aims exclude from p/n
I YT("CODE")="AIMS" S $P(ARRAY(CNT),U,6)=1
;Prompt text
S WPTXT(CNT,1)=YT("CODE")_" (Mental Health Instrument)"
;test
W !!,CNT,?5,WPTXT(CNT,1)
Q 1
;
;Sub-routine to update dialog file #801.41
;-----------------------------------------
UPDATE(INP,WPTXT,DTYPE) ;
N CNT,DATA,DESC,IEN,STRING,SUB,TEXT
N FDA,FDAIEN,MSG
;Get each dialog line in turn
S STRING="Updating "_$S(DTYPE="E":"Dialog Elements",1:"Reminder Dialog")
D BMES^XPDUTL(STRING)
;
;Create FDA for each entry in array
S CNT=""
F S CNT=$O(INP(CNT)) Q:CNT="" D Q:$D(MSG)
.;If finding is a finding item parameter no need to build an element
.I DTYPE="E",$P(INP(CNT),U)=801.43 D Q
..S DSET(1,CNT)=$P(INP(CNT),U,2)
.;Build FDA array
.K FDAIEN,FDA
.;If existing element and not in replace mode don't update FDA
.I DTYPE="E",'PXRMREPL Q:$$EXISTS($P(INP(CNT),U))
.;Name
.S FDA(801.41,"?+1,",.01)=$P(INP(CNT),U)
.;Dialog type
.S FDA(801.41,"?+1,",4)=DTYPE
.;Class
.S FDA(801.41,"?+1,",100)="L"
.;Sponsor
.S FDA(801.41,"?+1,",101)=""
.;Prompt text/finding entries
.I DTYPE="E" D
..S FDA(801.41,"?+1,",13)=$P(INP(CNT),U,2)
..S FDA(801.41,"?+1,",15)=$P(INP(CNT),U,3)
..S FDA(801.41,"?+1,",17)=$P(INP(CNT),U,4)
..S FDA(801.41,"?+1,",25)="WPTXT("_CNT_")"
..;MH fields (exclude from P/N and results pointer)
..S:$P(INP(CNT),U,6) FDA(801.41,"?+1,",54)=$P(INP(CNT),U,6)
..;S:$P(INP(CNT),U,7) FDA(801.41,"?+1,",55)=$P(INP(CNT),U,7)
.;Reminder dialog associated reminder/DISABLE
.I DTYPE="R" D
..S FDA(801.41,"?+1,",2)=REM
..I PXRMENAB'="Y" S FDA(801.41,"?+1,",3)=1
.;Dialog items point to prompts and actions, Sets point to dialog items
.N ACNT,SUB
.;S ACNT=0,SUB=2
.S ACNT=0,SUB=1
.F S ACNT=$O(INP(CNT,ACNT)) Q:ACNT="" D
..S SUB=SUB+1,FDA(801.412,"?+"_SUB_",?+1,",.01)=ACNT
..S FDA(801.412,"?+"_SUB_",?+1,",2)=$P(INP(CNT,ACNT),U)
..S FDA(801.412,"?+"_SUB_",?+1,",6)=$P(INP(CNT,ACNT),U,2)
..S FDA(801.412,"?+"_SUB_",?+1,",7)=$P(INP(CNT,ACNT),U,3)
..S FDA(801.412,"?+"_SUB_",?+1,",8)=$P(INP(CNT,ACNT),U,4)
..S FDA(801.412,"?+"_SUB_",?+1,",9)=$P(INP(CNT,ACNT),U,5)
.;Update #801.41
.D UPDATE^DIE("","FDA","FDAIEN","MSG")
.I $D(MSG) D ERR($G(INP(CNT))) Q
.;Save IEN of dialog created/used for later use in building dialog set
.I DTYPE="E" S DSET(1,CNT*5)=FDAIEN(1)
.;Insert link to reminder
.I DTYPE="R",PXRMLINK="Y" D
..S $P(^PXD(811.9,REM,51),U)=FDAIEN(1),^PXD(811.9,"AG",FDAIEN(1),REM)=""
.;Update Edit History
.D HIS(FDAIEN(1))
Q
PXRMDBL3 ; SLC/PJH - Reminder Dialog Generation. (overflow) ;06/08/2009
+1 ;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
+2 ;
+3 ; Called from PXRMDBL1
+4 ;
+5 ;Set number range for site
START ;
+1 DO SETSTART^PXRMCOPY("^PXRMD(801.41,")
+2 ;Update dialog file for individual dialog items
+3 DO UPDATE(.ARRAY,.WPTXT,"E")
+4 ;Create reminder dialog
+5 DO UPDATE(.DSET,"","R")
+6 ;
+7 WRITE !!,"Dialog build complete"
HANG 3
END QUIT
+1 ;
+2 ;Error Handler
+3 ;-------------
ERR(DESC) ;
+1 NEW ERROR,IC,REF
+2 SET ERROR(1)="Unable to update dialog file : "_DESC
+3 SET ERROR(2)="Error in UPDATE^DIE, needs further investigation"
+4 ;Move MSG into ERROR
+5 SET REF="MSG"
+6 FOR IC=3:1
SET REF=$QUERY(@REF)
IF REF=""
QUIT
SET ERROR(IC)=REF_"="_@REF
+7 ;Screen message
+8 DO BMES^XPDUTL(.ERROR)
+9 QUIT
+10 ;
+11 ;Check if dialog element already exists
+12 ;--------------------------------------
EXISTS(NAME) ;
+1 NEW IEN
SET IEN=$ORDER(^PXRMD(801.41,"B",NAME,""))
+2 IF IEN
SET DSET(1,CNT*5)=IEN
QUIT 1
+3 QUIT 0
+4 ;
+5 ;Update edit history
+6 ;-------------------
HIS(IENN) ;
+1 ;First delete any existing history entries.
+2 NEW ENTRY,IND,IENS,FDA,FDAIEN,MSG,WP
+3 SET ENTRY="^PXRMD(801.41,"_IENN_",110)"
+4 SET IND=0
+5 FOR
SET IND=$ORDER(@ENTRY@(IND))
IF +IND=0
QUIT
Begin DoDot:1
+6 SET IENS=IND_","_IENN_","
+7 SET FDA(801.44,IENS,.01)="@"
End DoDot:1
+8 IF $DATA(FDA(801.44))
Begin DoDot:1
+9 DO FILE^DIE("K","FDA","MSG")
IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
+10 ;Establish an initial entry in the edit history.
+11 KILL FDA,MSG
+12 SET IENS="+1,"_IENN_","
+13 SET FDAIEN(IENN)=IENN
+14 SET FDA(801.44,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+15 SET FDA(801.44,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
+16 SET FDA(801.44,IENS,2)="WP(1,1)"
+17 SET WP(1,1,1)="Autogenerated"
+18 DO UPDATE^DIE("E","FDA","FDAIEN","MSG")
+19 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+20 QUIT
+21 ;
+22 ;Mental Health
+23 ;-------------
MHOK(IEN) ;
+1 NEW DSHORT,RNAME,TEST,YT
SET YT=""
+2 ;Convert ien to name
+3 ;DBIA #5044
+4 SET YT("CODE")=$PIECE($GET(^YTT(601.71,IEN,0)),U)
+5 ;Quit if no code found
+6 IF YT("CODE")=""
QUIT 0
+7 IF '$$OK^PXRMDLL(IEN)
QUIT 0
+8 ;Check if valid
+9 ;I TEST(1)["[ERROR]" Q 0
+10 ;
+11 SET DNAME=FTYP_" "_YT("CODE")
+12 ;Create arrays
+13 SET CNT=CNT+1
+14 ;Convert dialog item name to UC
+15 SET DNAME=$TRANSLATE(DNAME,LOWER,UPPER)
+16 ;Truncate the item name - without finesse
+17 SET DSHORT=DNAME
+18 IF $LENGTH(DSHORT)>40
SET DSHORT=$EXTRACT(DNAME,1,40)
+19 ;Dialog item name, finding item and result
+20 SET ARRAY(CNT)=DSHORT_U_U_RESN_U
+21 ;Commented out Result Group Patch 6 until a decision can be made
+22 ;Result group name
+23 ;S RNAME="PXRM "_YT("CODE")_" RESULT GROUP"
+24 ;Result pointer
+25 ;S $P(ARRAY(CNT),U,7)=$O(^PXRMD(801.41,"B",RNAME,""))
+26 ;If aims exclude from p/n
+27 IF YT("CODE")="AIMS"
SET $PIECE(ARRAY(CNT),U,6)=1
+28 ;Prompt text
+29 SET WPTXT(CNT,1)=YT("CODE")_" (Mental Health Instrument)"
+30 ;test
+31 WRITE !!,CNT,?5,WPTXT(CNT,1)
+32 QUIT 1
+33 ;
+34 ;Sub-routine to update dialog file #801.41
+35 ;-----------------------------------------
UPDATE(INP,WPTXT,DTYPE) ;
+1 NEW CNT,DATA,DESC,IEN,STRING,SUB,TEXT
+2 NEW FDA,FDAIEN,MSG
+3 ;Get each dialog line in turn
+4 SET STRING="Updating "_$SELECT(DTYPE="E":"Dialog Elements",1:"Reminder Dialog")
+5 DO BMES^XPDUTL(STRING)
+6 ;
+7 ;Create FDA for each entry in array
+8 SET CNT=""
+9 FOR
SET CNT=$ORDER(INP(CNT))
IF CNT=""
QUIT
Begin DoDot:1
+10 ;If finding is a finding item parameter no need to build an element
+11 IF DTYPE="E"
IF $PIECE(INP(CNT),U)=801.43
Begin DoDot:2
+12 SET DSET(1,CNT)=$PIECE(INP(CNT),U,2)
End DoDot:2
QUIT
+13 ;Build FDA array
+14 KILL FDAIEN,FDA
+15 ;If existing element and not in replace mode don't update FDA
+16 IF DTYPE="E"
IF 'PXRMREPL
IF $$EXISTS($PIECE(INP(CNT),U))
QUIT
+17 ;Name
+18 SET FDA(801.41,"?+1,",.01)=$PIECE(INP(CNT),U)
+19 ;Dialog type
+20 SET FDA(801.41,"?+1,",4)=DTYPE
+21 ;Class
+22 SET FDA(801.41,"?+1,",100)="L"
+23 ;Sponsor
+24 SET FDA(801.41,"?+1,",101)=""
+25 ;Prompt text/finding entries
+26 IF DTYPE="E"
Begin DoDot:2
+27 SET FDA(801.41,"?+1,",13)=$PIECE(INP(CNT),U,2)
+28 SET FDA(801.41,"?+1,",15)=$PIECE(INP(CNT),U,3)
+29 SET FDA(801.41,"?+1,",17)=$PIECE(INP(CNT),U,4)
+30 SET FDA(801.41,"?+1,",25)="WPTXT("_CNT_")"
+31 ;MH fields (exclude from P/N and results pointer)
+32 IF $PIECE(INP(CNT),U,6)
SET FDA(801.41,"?+1,",54)=$PIECE(INP(CNT),U,6)
+33 ;S:$P(INP(CNT),U,7) FDA(801.41,"?+1,",55)=$P(INP(CNT),U,7)
End DoDot:2
+34 ;Reminder dialog associated reminder/DISABLE
+35 IF DTYPE="R"
Begin DoDot:2
+36 SET FDA(801.41,"?+1,",2)=REM
+37 IF PXRMENAB'="Y"
SET FDA(801.41,"?+1,",3)=1
End DoDot:2
+38 ;Dialog items point to prompts and actions, Sets point to dialog items
+39 NEW ACNT,SUB
+40 ;S ACNT=0,SUB=2
+41 SET ACNT=0
SET SUB=1
+42 FOR
SET ACNT=$ORDER(INP(CNT,ACNT))
IF ACNT=""
QUIT
Begin DoDot:2
+43 SET SUB=SUB+1
SET FDA(801.412,"?+"_SUB_",?+1,",.01)=ACNT
+44 SET FDA(801.412,"?+"_SUB_",?+1,",2)=$PIECE(INP(CNT,ACNT),U)
+45 SET FDA(801.412,"?+"_SUB_",?+1,",6)=$PIECE(INP(CNT,ACNT),U,2)
+46 SET FDA(801.412,"?+"_SUB_",?+1,",7)=$PIECE(INP(CNT,ACNT),U,3)
+47 SET FDA(801.412,"?+"_SUB_",?+1,",8)=$PIECE(INP(CNT,ACNT),U,4)
+48 SET FDA(801.412,"?+"_SUB_",?+1,",9)=$PIECE(INP(CNT,ACNT),U,5)
End DoDot:2
+49 ;Update #801.41
+50 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+51 IF $DATA(MSG)
DO ERR($GET(INP(CNT)))
QUIT
+52 ;Save IEN of dialog created/used for later use in building dialog set
+53 IF DTYPE="E"
SET DSET(1,CNT*5)=FDAIEN(1)
+54 ;Insert link to reminder
+55 IF DTYPE="R"
IF PXRMLINK="Y"
Begin DoDot:2
+56 SET $PIECE(^PXD(811.9,REM,51),U)=FDAIEN(1)
SET ^PXD(811.9,"AG",FDAIEN(1),REM)=""
End DoDot:2
+57 ;Update Edit History
+58 DO HIS(FDAIEN(1))
End DoDot:1
IF $DATA(MSG)
QUIT
+59 QUIT
