- 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 Feb 18, 2025@23:16:49 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