PXRMXTB ; SLC/PJH - Reminder Reports Template Load ;01/28/2013
;;2.0;CLINICAL REMINDERS;**6,12,26**;Feb 04, 2005;Build 404
;
; Called from PXRMXD
;
;Select Template
;---------------
START N X,Y,CNT,FOUND,PXRMFLD,DIC,MSG
N ERR,SEQ,TMPLST,LIST
K DIROUT,DIRUT,DTOUT,DUOUT
S PXRMTMP="",FOUND=0
;
;Check if any templates exist for the user
D GETLST^XPAR(.TMPLST,"USR","PXRM REPORT TEMPLATE (USER)","Q",.ERR)
I ERR>0 W !!,?5,"Error: "_$P(ERR,U,2) S DUOUT=1 H 2 Q
I 'TMPLST W !!,?5,"No report Templates for this user" S DUOUT=1 H 2 Q
;Build list of templates
S SEQ=0
F S SEQ=$O(TMPLST(SEQ)) Q:'SEQ D
.S Y=$P(TMPLST(SEQ),U,2) Q:'Y
.S LIST(Y)=""
;
;Select template required
W !
S CNT=0,DIC=810.1,DIC(0)="AEQMZ"
S DIC("A")="Select REPORT TEMPLATE:"
S DIC("S")="I $D(LIST(+Y)),$P(^PXRMPT(810.1,+Y,0),U,3)=PXRMTYP"
D ^DIC
W !!,"1"
I X="" S DUOUT=1
I X=(U_U) S DTOUT=1
I '$D(DTOUT),('$D(DUOUT)) D
.I +Y'=-1 D Q
..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
K DIC
;
;Load template into local array
I (+Y'=-1)&('$D(DTOUT))&('$D(DUOUT)) D
.L +^PXRMPT(810.1,$P(Y,U)):DILOCKTM
.E W !!?5,"Another user is editing this entry." S DUOUT=1 Q
.;Load template into an array
.S PXRMTMP=Y_U_$P(Y(0),U,2) D LOAD^PXRMXT
.L -^PXRMPT(810.1,$P(PXRMTMP,U))
.;Exit if problem loading template
.I $D(MSG) S DTOUT=1 Q
.;Display Template information
.D:'$D(MSG) ^PXRMXTD
EXIT Q
;
XREF ;
K MREF,XREF
S XREF("NAME")=.01
S XREF("TITLE")=1.9
S XREF("PXRMTYP")=1.1
S XREF("PXRMSEL")=1.2
S XREF("PXRMPRIM")=1.3
S XREF("PXRMREP")=1.4
S XREF("PXRMLCSC")=1.5
S XREF("PXRMFD")=1.6
S XREF("PXRMPML")=1.7
S XREF("PXRMPER")=1.8
S XREF("PXRMREM")=2
S XREF("PXRMFAC")=3
S XREF("PXRMPRV")=4
S XREF("RUN")=5
S XREF("PXRMPAT")=6
S XREF("PXRMOTM")=7
S XREF("PXRMPCM")=8
S XREF("PXRMSCAT")=9
S XREF("PXRMLCHL")=10
S XREF("PXRMCS")=11
S XREF("PXRMCGRP")=12
S XREF("PXRMRCAT")=13
S XREF("PXRMLIST")=14
S XREF("PXRMOWN")=15
;
S MREF("REMINDER")=.01
S MREF("PATIENT")=.01
S MREF("PROVIDER")=.01
S MREF("OERR TEAM")=.01
S MREF("PCMM TEAM")=.01
S MREF("FACILITY")=.01
S MREF("SERVICE")=.01
S MREF("LOCATION")=.01
S MREF("STOP CODE")=.01
S MREF("CLINIC GROUP")=.01
S MREF("DISPLAY ORDER")=.02
S MREF("REMINDER CATEGORY")=.01
S MREF("DISPLAY")=.02
S MREF("PXRMLIST")=.01
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXTB 2403 printed Dec 13, 2024@01:50:26 Page 2
PXRMXTB ; SLC/PJH - Reminder Reports Template Load ;01/28/2013
+1 ;;2.0;CLINICAL REMINDERS;**6,12,26**;Feb 04, 2005;Build 404
+2 ;
+3 ; Called from PXRMXD
+4 ;
+5 ;Select Template
+6 ;---------------
START NEW X,Y,CNT,FOUND,PXRMFLD,DIC,MSG
+1 NEW ERR,SEQ,TMPLST,LIST
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET PXRMTMP=""
SET FOUND=0
+4 ;
+5 ;Check if any templates exist for the user
+6 DO GETLST^XPAR(.TMPLST,"USR","PXRM REPORT TEMPLATE (USER)","Q",.ERR)
+7 IF ERR>0
WRITE !!,?5,"Error: "_$PIECE(ERR,U,2)
SET DUOUT=1
HANG 2
QUIT
+8 IF 'TMPLST
WRITE !!,?5,"No report Templates for this user"
SET DUOUT=1
HANG 2
QUIT
+9 ;Build list of templates
+10 SET SEQ=0
+11 FOR
SET SEQ=$ORDER(TMPLST(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+12 SET Y=$PIECE(TMPLST(SEQ),U,2)
if 'Y
QUIT
+13 SET LIST(Y)=""
End DoDot:1
+14 ;
+15 ;Select template required
+16 WRITE !
+17 SET CNT=0
SET DIC=810.1
SET DIC(0)="AEQMZ"
+18 SET DIC("A")="Select REPORT TEMPLATE:"
+19 SET DIC("S")="I $D(LIST(+Y)),$P(^PXRMPT(810.1,+Y,0),U,3)=PXRMTYP"
+20 DO ^DIC
+21 WRITE !!,"1"
+22 IF X=""
SET DUOUT=1
+23 IF X=(U_U)
SET DTOUT=1
+24 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:1
+25 IF +Y'=-1
Begin DoDot:2
+26 SET CNT=CNT+1
SET ARRAY(CNT)=Y_U_Y(0,0)_U_$PIECE(Y(0),U,3)
End DoDot:2
QUIT
End DoDot:1
+27 KILL DIC
+28 ;
+29 ;Load template into local array
+30 IF (+Y'=-1)&('$DATA(DTOUT))&('$DATA(DUOUT))
Begin DoDot:1
+31 LOCK +^PXRMPT(810.1,$PIECE(Y,U)):DILOCKTM
+32 IF '$TEST
WRITE !!?5,"Another user is editing this entry."
SET DUOUT=1
QUIT
+33 ;Load template into an array
+34 SET PXRMTMP=Y_U_$PIECE(Y(0),U,2)
DO LOAD^PXRMXT
+35 LOCK -^PXRMPT(810.1,$PIECE(PXRMTMP,U))
+36 ;Exit if problem loading template
+37 IF $DATA(MSG)
SET DTOUT=1
QUIT
+38 ;Display Template information
+39 if '$DATA(MSG)
DO ^PXRMXTD
End DoDot:1
EXIT QUIT
+1 ;
XREF ;
+1 KILL MREF,XREF
+2 SET XREF("NAME")=.01
+3 SET XREF("TITLE")=1.9
+4 SET XREF("PXRMTYP")=1.1
+5 SET XREF("PXRMSEL")=1.2
+6 SET XREF("PXRMPRIM")=1.3
+7 SET XREF("PXRMREP")=1.4
+8 SET XREF("PXRMLCSC")=1.5
+9 SET XREF("PXRMFD")=1.6
+10 SET XREF("PXRMPML")=1.7
+11 SET XREF("PXRMPER")=1.8
+12 SET XREF("PXRMREM")=2
+13 SET XREF("PXRMFAC")=3
+14 SET XREF("PXRMPRV")=4
+15 SET XREF("RUN")=5
+16 SET XREF("PXRMPAT")=6
+17 SET XREF("PXRMOTM")=7
+18 SET XREF("PXRMPCM")=8
+19 SET XREF("PXRMSCAT")=9
+20 SET XREF("PXRMLCHL")=10
+21 SET XREF("PXRMCS")=11
+22 SET XREF("PXRMCGRP")=12
+23 SET XREF("PXRMRCAT")=13
+24 SET XREF("PXRMLIST")=14
+25 SET XREF("PXRMOWN")=15
+26 ;
+27 SET MREF("REMINDER")=.01
+28 SET MREF("PATIENT")=.01
+29 SET MREF("PROVIDER")=.01
+30 SET MREF("OERR TEAM")=.01
+31 SET MREF("PCMM TEAM")=.01
+32 SET MREF("FACILITY")=.01
+33 SET MREF("SERVICE")=.01
+34 SET MREF("LOCATION")=.01
+35 SET MREF("STOP CODE")=.01
+36 SET MREF("CLINIC GROUP")=.01
+37 SET MREF("DISPLAY ORDER")=.02
+38 SET MREF("REMINDER CATEGORY")=.01
+39 SET MREF("DISPLAY")=.02
+40 SET MREF("PXRMLIST")=.01
+41 QUIT
