Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMDBL3

PXRMDBL3.m

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