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

PXRMXTU.m

Go to the documentation of this file.
  1. PXRMXTU ; SLC/PJH - Reminder Reports Template Update ;07/30/2009
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
  1. ;
  1. ; Called from PXRMYD,PXRMXD (also at UPD from PXRMXPR/PXRMYPR)
  1. ;
  1. ;Option to create a new template
  1. ;-------------------------------
  1. START N PXRMASK,MSG D ASK(.PXRMASK)
  1. I $G(PXRMASK)="Y" D SAVE
  1. EXIT Q
  1. ;
  1. ;Ask name for new template
  1. ;-------------------------
  1. SAVE N X,Y,DIC,DLAYGO
  1. SAV1 S DIC=810.1,DLAYGO=DIC,DIC(0)="QAELX"
  1. S DIC("A")="STORE REPORT LOGIC IN TEMPLATE NAME: "
  1. W !
  1. D ^DIC
  1. I X="" W !,"A template name must be entered" G SAV1
  1. I X=(U_U) S DTOUT=1
  1. I Y=-1 S DUOUT=1 W !,"Details not saved" Q
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. ;Check
  1. I ($P(Y,U,3)'=1) W !,"This template name already exists" G SAV1
  1. ;Get template name and title
  1. S PXRMTMP=Y,TITLE=$P($G(^PXRMPT(810.1,$P(Y,U),0)),U,2)
  1. S $P(PXRMTMP,U,3)=TITLE
  1. ;File details
  1. D FILE(Y,1,0)
  1. ;File not saved message
  1. I $D(MSG) D Q
  1. .N DA,DIK
  1. .S DA=$P(Y,U),DIK="^PXRMPT(810.1," D ^DIK
  1. .D MESS^PXRMXTF(4,$P(PXRMTMP,U,2))
  1. ;File saved message
  1. D MESS^PXRMXTF(1,$P(PXRMTMP,U,2))
  1. Q
  1. ;
  1. ;File template detail
  1. ;--------------------
  1. FILE(INP,UPD,CLR) ;
  1. N CNT,FDA,FDAIEN,FNO,IC,INT,MODE,NAME,X
  1. S FDAIEN(1)=$P(INP,U),NAME=$P(INP,U,2)
  1. ;Save exit flags - needed for rollback
  1. N DUOUT,DTOUT
  1. ;
  1. ;Update or Add
  1. S MODE=$S(UPD:(FDAIEN(1)_","),1:"+1,")
  1. ;Delete entries from existing template
  1. I CLR D
  1. .N DA S DA=0
  1. .F S DA=$O(^PXRMPT(810.1,FDAIEN(1),DA)) Q:'DA D
  1. ..K ^PXRMPT(810.1,FDAIEN(1),DA)
  1. ;
  1. I PXRMSEL="L" S X=PXRMLCSC,PXRMLCSC=$P(PXRMLCSC,U)
  1. ;
  1. N MREF,XREF
  1. D XREF^PXRMXTB
  1. ;
  1. ;Save single fields into FDA
  1. F IC="NAME","PXRMLCSC","PXRMPRIM","PXRMREP","PXRMSEL","PXRMTYP","PXRMPML","PXRMPER" D
  1. .S FDA(810.1,MODE,XREF(IC))=$G(@IC)
  1. F IC="PXRMFD","PXRMSCAT","RUN","TITLE" D
  1. .S FDA(810.1,MODE,XREF(IC))=$G(@IC)
  1. ;Save Owner value
  1. S FDA(810.1,MODE,15)=$S(+$G(PXRMOWN)>0:PXRMOWN,1:DUZ)
  1. ;
  1. I PXRMSEL="L" S PXRMLCSC=X
  1. ;
  1. ;Save Arrays into FDA
  1. ;
  1. ;Reminder Items
  1. S CNT=1
  1. D SUB1(.PXRMREM,"810.12",1)
  1. ;Save Facility codes
  1. D SUB1(.PXRMFAC,"810.13",1)
  1. ;Save Provider codes
  1. D SUB1(.PXRMPRV,"810.14",1)
  1. ;Save Patient codes
  1. D SUB1(.PXRMPAT,"810.16",1)
  1. ;Save OE/RR Team codes
  1. D SUB1(.PXRMOTM,"810.17",1)
  1. ;Save PCMM Team codes
  1. D SUB1(.PXRMPCM,"810.18",1)
  1. ;Save Hospital Location codes
  1. D SUB1(.PXRMLCHL,"810.11",2)
  1. ;Save Clinic Stop codes
  1. D SUB1(.PXRMCS,"810.111",2)
  1. ;Save Clinic groups
  1. D SUB1(.PXRMCGRP,"810.112",1)
  1. ;Save Reminder Categories
  1. D SUB1(.PXRMRCAT,"810.113",1)
  1. ;Save Patient lists
  1. D SUB1(.PXRMLIST,"810.114",1)
  1. ;
  1. ;Update template file
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. ;
  1. I $D(MSG) D
  1. .W !!,"Update failed, UPDATE^DIE returned the following error message:"
  1. .S IC="MSG"
  1. .F S IC=$Q(@IC) Q:IC="" W !,IC,"=",@IC
  1. .W !,"Examine the above error message for the reason.",!
  1. .H 2
  1. Q
  1. ;
  1. ;Save arrays into FDA
  1. ;--------------------
  1. SUB1(OUTPUT,VAR,PIECE) ;
  1. S IC=""
  1. ;This is use for saving individual reminders back to the original
  1. ;template
  1. I VAR=810.12,$D(PXRMTREM($P(INP,U)))>0 D Q
  1. .F S IC=$O(PXRMTREM($P(INP,U),IC)) Q:IC="" D
  1. ..S INT=$P(PXRMTREM($P(INP,U),IC),U,PIECE),CNT=CNT+1
  1. ..S FDA(VAR,"+"_CNT_","_MODE,.01)=INT
  1. ..S FDA(VAR,"+"_CNT_","_MODE,.02)=IC
  1. ;
  1. ;This is use for saving individual reminders category back to the
  1. ;original template
  1. I VAR=810.113,$D(PXRMTCAT($P(INP,U)))>0 D Q
  1. .F S IC=$O(PXRMTCAT($P(INP,U),IC)) Q:IC="" D
  1. ..S INT=$P(PXRMTCAT($P(INP,U),IC),U,PIECE),CNT=CNT+1
  1. ..S FDA(VAR,"+"_CNT_","_MODE,.01)=INT
  1. ..S FDA(VAR,"+"_CNT_","_MODE,.02)=IC
  1. ;
  1. ;this is use for saving everything else to the template
  1. F S IC=$O(OUTPUT(IC)) Q:IC="" D
  1. .S INT=$P(OUTPUT(IC),U,PIECE),CNT=CNT+1
  1. .S FDA(VAR,"+"_CNT_","_MODE,.01)=INT
  1. .;Save Display order for reminders and categories
  1. .I (VAR=810.12)!(VAR=810.113) S FDA(VAR,"+"_CNT_","_MODE,.02)=IC
  1. Q
  1. ;
  1. ;Save Service Categories into FDA
  1. ;--------------------------------
  1. SUB2(FLD,VAR) ;
  1. F IC=1:1 S INT=$E(@FLD,IC) Q:INT="" D
  1. .S CNT=CNT+1,FDA(VAR,"+"_CNT_","_MODE,.01)=INT
  1. Q
  1. ;
  1. ;
  1. ;Option to save a new template
  1. ;-----------------------------
  1. ASK(YESNO) ;
  1. N X,Y,TEXT
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="YA0"
  1. S DIR("A")="Create a new report template: "
  1. S DIR("B")="N"
  1. S DIR("?")="Enter Y or N. For detailed help type ??"
  1. S DIR("??")=U_"D HELP^PXRMXTU(1)"
  1. W !
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S YESNO=$E(Y(0))
  1. Q
  1. ;
  1. ;General help text routine. Write out the text in the HTEXT array
  1. ;----------------------------------------------------------------
  1. HELP(CALL) ;
  1. N HTEXT
  1. N DIWF,DIWL,DIWR,IC
  1. S DIWF="C70",DIWL=0,DIWR=70
  1. ;
  1. I CALL=1 D
  1. .S HTEXT(1)="Enter 'Y' to save the reporting parameters as a report"
  1. .S HTEXT(2)="template from which the report may be re-run in future."
  1. ;
  1. K ^UTILITY($J,"W")
  1. S IC=""
  1. F S IC=$O(HTEXT(IC)) Q:IC="" D
  1. . S X=HTEXT(IC)
  1. . D ^DIWP
  1. W !
  1. S IC=0
  1. F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
  1. . W !,^UTILITY($J,"W",0,IC,0)
  1. K ^UTILITY($J,"W")
  1. W !
  1. Q
  1. ;
  1. ;Save template info to new name
  1. ;------------------------------
  1. COPY N PXRMLCSC,PXRMPRIM,PRRMREP,PXRMSEL,PXRMTYP,PXRMFD,RUN,PXRMCS
  1. N PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS
  1. ;Load arrays from original template PXRMTMP
  1. D LOAD^PXRMXT I $D(MSG) Q
  1. ;Clear last run date
  1. S RUN=""
  1. ;Save arrays to new ID
  1. D FILE(NEWTEMP,0)
  1. Q
  1. ;
  1. ;Update print template last run date (called from PXRMYPR/PXRMXPR)
  1. ;-----------------------------------------------------------------
  1. UPD S ^PXRMPT(810.1,$P(PXRMTMP,U),7)=PXRMXST
  1. Q
  1. ;
  1. ;Called as an input transform for 810.1/NAME
  1. ;-------------------------------------------
  1. NAME Q:'$D(X) Q:X="" Q:$G(PXRMTYP)=""
  1. ;Disallow duplicate template names
  1. Q:'$D(^PXRMPT(810.1,"B",X))
  1. W !,"This template name already exists" K X
  1. Q
  1. ;
  1. ;Called as an input transform for 810.1/PXRMFD
  1. ;---------------------------------------------
  1. INP Q:'$D(X) Q:X=""
  1. ;If inpatient wards prompt only for Admissions/Current Patients
  1. I $G(PXRMINP),"FP"[X D
  1. .W !,"Select either Inpatient Admissions or Current Inpatients" K X
  1. ;If other locations prompt only for Prior visits/Future Appts
  1. I '$G(PXRMINP),"AC"[X D
  1. .W !,"Select either Future Appointments or Prior Visits" K X
  1. Q