Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTB.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTB.m
r613 r623 1 PXRMXTB ; SLC/PJH - Reminder Reports Template Load ;11/27/2006 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ; Called from PXRMXD 5 ; 6 ;Select Template 7 ;--------------- 8 START N X,Y,CNT,FOUND,PXRMFLD,DIC,MSG 9 N ERR,SEQ,TMPLST,LIST 10 K DIROUT,DIRUT,DTOUT,DUOUT 11 S PXRMTMP="",FOUND=0 12 ; 13 ;Check if any templates exist for the user 14 D GETLST^XPAR(.TMPLST,"USR","PXRM REPORT TEMPLATE (USER)","Q",.ERR) 15 I ERR>0 W !!,?5,"Error: "_$P(ERR,U,2) S DUOUT=1 H 2 Q 16 I 'TMPLST W !!,?5,"No report Templates for this user" S DUOUT=1 H 2 Q 17 ;Build list of templates 18 S SEQ=0 19 F S SEQ=$O(TMPLST(SEQ)) Q:'SEQ D 20 .S Y=$P(TMPLST(SEQ),U,2) Q:'Y 21 .S LIST(Y)="" 22 ; 23 ;Select template required 24 W ! 25 S CNT=0,DIC=810.1,DIC(0)="AEQMZ" 26 S DIC("A")="Select REPORT TEMPLATE:" 27 S DIC("S")="I $D(LIST(+Y)),$P(^PXRMPT(810.1,+Y,0),U,3)=PXRMTYP" 28 D ^DIC 29 W !!,"1" 30 I X="" S DUOUT=1 31 I X=(U_U) S DTOUT=1 32 I '$D(DTOUT),('$D(DUOUT)) D 33 .I +Y'=-1 D Q 34 ..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3) 35 K DIC 36 ; 37 ;Load template into local array 38 I (+Y'=-1)&('$D(DTOUT))&('$D(DUOUT)) D 39 .L +^PXRMPT(810.1,$P(Y,U)):0 40 .E W !!?5,"Another user is editing this entry." S DUOUT=1 Q 41 .;Load template into an array 42 .S PXRMTMP=Y_U_$P(Y(0),U,2) D LOAD^PXRMXT 43 .L -^PXRMPT(810.1,$P(PXRMTMP,U)) 44 .;Exit if problem loading template 45 .I $D(MSG) S DTOUT=1 Q 46 .;Display Template information 47 .D:'$D(MSG) ^PXRMXTD 48 EXIT Q 49 ; 50 XREF ; 51 K MREF,XREF 52 S XREF("NAME")=.01 53 S XREF("TITLE")=1.9 54 S XREF("PXRMTYP")=1.1 55 S XREF("PXRMSEL")=1.2 56 S XREF("PXRMPRIM")=1.3 57 S XREF("PXRMREP")=1.4 58 S XREF("PXRMLCSC")=1.5 59 S XREF("PXRMFD")=1.6 60 S XREF("PXRMPML")=1.7 61 S XREF("PXRMREM")=2 62 S XREF("PXRMFAC")=3 63 S XREF("PXRMPRV")=4 64 S XREF("RUN")=5 65 S XREF("PXRMPAT")=6 66 S XREF("PXRMOTM")=7 67 S XREF("PXRMPCM")=8 68 S XREF("PXRMSCAT")=9 69 S XREF("PXRMLCHL")=10 70 S XREF("PXRMCS")=11 71 S XREF("PXRMCGRP")=12 72 S XREF("PXRMRCAT")=13 73 S XREF("PXRMLIST")=14 74 ; 75 S MREF("REMINDER")=.01 76 S MREF("PATIENT")=.01 77 S MREF("PROVIDER")=.01 78 S MREF("OERR TEAM")=.01 79 S MREF("PCMM TEAM")=.01 80 S MREF("FACILITY")=.01 81 S MREF("SERVICE")=.01 82 S MREF("LOCATION")=.01 83 S MREF("STOP CODE")=.01 84 S MREF("CLINIC GROUP")=.01 85 S MREF("DISPLAY ORDER")=.02 86 S MREF("REMINDER CATEGORY")=.01 87 S MREF("DISPLAY")=.02 88 S MREF("PXRMLIST")=.01 89 Q 1 PXRMXTB ; SLC/PJH - Reminder Reports Template Load ;08/01/2001 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ; Called from PXRMXD 5 ; 6 ;Select Template 7 ;--------------- 8 START N X,Y,CNT,FOUND,PXRMFLD,DIC,MSG 9 N ERR,SEQ,TMPLST,LIST 10 K DIROUT,DIRUT,DTOUT,DUOUT 11 S PXRMTMP="",FOUND=0 12 ; 13 ;Check if any templates exist for the user 14 D GETLST^XPAR(.TMPLST,"USR","PXRM REPORT TEMPLATE (USER)","Q",.ERR) 15 I ERR>0 W !!,?5,"Error: "_$P(ERR,U,2) S DUOUT=1 H 2 Q 16 I 'TMPLST W !!,?5,"No report Templates for this user" S DUOUT=1 H 2 Q 17 ;Build list of templates 18 S SEQ=0 19 F S SEQ=$O(TMPLST(SEQ)) Q:'SEQ D 20 .S Y=$P(TMPLST(SEQ),U,2) Q:'Y 21 .S LIST(Y)="" 22 ; 23 ;Select template required 24 W ! 25 S CNT=0,DIC=810.1,DIC(0)="AEQMZ" 26 S DIC("A")="Select REPORT TEMPLATE:" 27 S DIC("S")="I $D(LIST(+Y)),$P(^PXRMPT(810.1,+Y,0),U,3)=PXRMTYP" 28 D ^DIC 29 W !!,"1" 30 I X="" S DUOUT=1 31 I X=(U_U) S DTOUT=1 32 I '$D(DTOUT),('$D(DUOUT)) D 33 .I +Y'=-1 D Q 34 ..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3) 35 K DIC 36 ; 37 ;Load template into local array 38 I (+Y'=-1)&('$D(DTOUT))&('$D(DUOUT)) D 39 .L +^PXRMPT(810.1,$P(Y,U)):0 40 .E W !!?5,"Another user is editing this entry." S DUOUT=1 Q 41 .;Load template into an array 42 .S PXRMTMP=Y_U_$P(Y(0),U,2) D LOAD^PXRMXT 43 .L -^PXRMPT(810.1,$P(PXRMTMP,U)) 44 .;Exit if problem loading template 45 .I $D(MSG) S DTOUT=1 Q 46 .;Display Template information 47 .D:'$D(MSG) ^PXRMXTD 48 EXIT Q 49 ; 50 XREF ; 51 K MREF,XREF 52 S XREF("NAME")=.01 53 S XREF("TITLE")=1.9 54 S XREF("PXRMTYP")=1.1 55 S XREF("PXRMSEL")=1.2 56 S XREF("PXRMPRIM")=1.3 57 S XREF("PXRMREP")=1.4 58 S XREF("PXRMLCSC")=1.5 59 S XREF("PXRMFD")=1.6 60 S XREF("PXRMREM")=2 61 S XREF("PXRMFAC")=3 62 S XREF("PXRMPRV")=4 63 S XREF("RUN")=5 64 S XREF("PXRMPAT")=6 65 S XREF("PXRMOTM")=7 66 S XREF("PXRMPCM")=8 67 S XREF("PXRMSCAT")=9 68 S XREF("PXRMLCHL")=10 69 S XREF("PXRMCS")=11 70 S XREF("PXRMCGRP")=12 71 S XREF("PXRMRCAT")=13 72 S XREF("PXRMLIST")=14 73 ; 74 S MREF("REMINDER")=.01 75 S MREF("PATIENT")=.01 76 S MREF("PROVIDER")=.01 77 S MREF("OERR TEAM")=.01 78 S MREF("PCMM TEAM")=.01 79 S MREF("FACILITY")=.01 80 S MREF("SERVICE")=.01 81 S MREF("LOCATION")=.01 82 S MREF("STOP CODE")=.01 83 S MREF("CLINIC GROUP")=.01 84 S MREF("DISPLAY ORDER")=.02 85 S MREF("REMINDER CATEGORY")=.01 86 S MREF("DISPLAY")=.02 87 S MREF("PXRMLIST")=.01 88 Q
Note:
See TracChangeset
for help on using the changeset viewer.
