- 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