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

PXRMXT.m

Go to the documentation of this file. 
  1. PXRMXT ; SLC/PJH - Reminder Reports Template Load ;01/28/2013
  1.  ;;2.0;CLINICAL REMINDERS;**4,26**;Feb 04, 2005;Build 404
  1.  ; 
  1.  ; Called from PXRMYD,PXRMXD
  1.  ;
  1.  ;Select Template
  1.  ;---------------
  1. START N X,Y,CNT,FOUND,PXRMFLD,DIC,MSG
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S PXRMTMP="",FOUND=0
  1.  ;
  1.  ;Check if any templates exist for this report type
  1.  Q:'$$FIND(PXRMTYP)
  1.  ;
  1.  ;Select template required
  1.  W !
  1.  S CNT=0,DIC=810.1,DIC(0)="AEQMZ"
  1.  S DIC("A")="Select an existing REPORT TEMPLATE or return to continue: "
  1.  S DIC("S")="I $P(^PXRMPT(810.1,+Y,0),U,3)=PXRMTYP"
  1.  D ^DIC
  1.  I X=(U_U) S DTOUT=1
  1.  I '$D(DTOUT),('$D(DUOUT)) D
  1.  .I +Y'=-1 D  Q
  1.  ..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
  1.  K DIC
  1.  ;
  1.  ;Load template into local array
  1.  I (+Y'=-1)&('$D(DTOUT))&('$D(DUOUT)) D
  1.  .L +^PXRMPT(810.1,$P(Y,U)):DILOCKTM
  1.  .E  W !!?5,"Another user is editing this entry." S DUOUT=1 Q
  1.  .;Load template into an array
  1.  .S PXRMTMP=Y_U_$P(Y(0),U,2) D LOAD
  1.  .L -^PXRMPT(810.1,$P(PXRMTMP,U))
  1.  .;Exit if problem loading template
  1.  .I $D(MSG) S DTOUT=1 Q
  1.  .;Display Template information
  1.  .D:'$D(MSG) ^PXRMXTD
  1.  ;
  1. EXIT Q
  1.  ;
  1.  ;Check if any templates exist for this report type
  1.  ;-------------------------------------------------
  1. FIND(TYP) ;
  1.  N SUB,FOUND
  1.  S SUB=0,FOUND=0
  1.  F  S SUB=$O(^PXRMPT(810.1,SUB)) Q:'SUB  D  Q:FOUND
  1.  .I $P($G(^PXRMPT(810.1,SUB,0)),U,3)=TYP S FOUND=1
  1.  Q FOUND
  1.  ;
  1.  ;
  1.  ;Load variables from report template (both INT and EXT)
  1.  ;------------------------------------------------------
  1. LOAD N ARRAY
  1.  D GETS^DIQ(810.1,$P(PXRMTMP,U),"**","IE","ARRAY","MSG")
  1.  I $D(MSG) D  Q
  1.  .W !!,"File read failed, GETS^DIQ returned the following error message:"
  1.  .N IC 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.  ;
  1.  N MREF,ORDER,ORDERC,SUB,SUB1,XREF
  1.  ;
  1.  S SUB1=$O(ARRAY(810.1,""))
  1.  D XREF^PXRMXTB
  1.  S SUB="" F  S SUB=$O(XREF(SUB)) Q:SUB=""  D 
  1.  .S @SUB=$G(ARRAY(810.1,SUB1,XREF(SUB),"I"))
  1.  ;
  1.  S PXRMFLD=$G(ARRAY(810.1,SUB1,XREF("PXRMSEL"),"E"))
  1.  S RUN=$G(ARRAY(810.1,SUB1,XREF("RUN"),"E"))
  1.  ;Update name if template has been renamed
  1.  S $P(PXRMTMP,U,2)=$G(ARRAY(810.1,SUB1,XREF("NAME"),"E"))
  1.  S TITLE=$G(ARRAY(810.1,SUB1,XREF("TITLE"),"E")),$P(PXRMTMP,U,3)=TITLE
  1.  ;
  1. MULT ;Clear multiple field arrays
  1.  K PXRMREM,PXRMPAT,PXRMPRV,PXRMOTM,PXRMFAC,PXRMLCHL,PXRMCS,PXRMCGRP
  1.  K PXRMFACN,PXRMCSN,PXRMCGRN,PXRMRCAT,REMINDER
  1.  ;
  1.  ;Load Multiple fields
  1.  D SUB(.PXRMREM,810.12,"REMINDER",1)
  1.  ;Load Patients
  1.  D SUB(.PXRMPAT,810.16,"PATIENT",1)
  1.  ;Load Providers
  1.  D SUB(.PXRMPRV,810.14,"PROVIDER",1)
  1.  ;Load OE/RR Teams
  1.  D SUB(.PXRMOTM,810.17,"OERR TEAM",1)
  1.  ;Load PCMM Teams
  1.  D SUB(.PXRMPCM,810.18,"PCMM TEAM",1)
  1.  ;Load Facility codes
  1.  D SUB(.PXRMFAC,810.13,"FACILITY",1)
  1.  ;Load Hospital Location codes
  1.  D SUB(.PXRMLCHL,810.11,"LOCATION",2)
  1.  ;Load Clinic Stop codes
  1.  D SUB(.PXRMCS,810.111,"STOP CODE",2)
  1.  ;Load Clinic Groups
  1.  D SUB(.PXRMCGRP,810.112,"CLINIC GROUP",1)
  1.  ;Load Reminder Categories
  1.  D SUB(.PXRMRCAT,810.113,"REMINDER CATEGORY",1)
  1.  ;Load Patient lists
  1.  D SUB(.PXRMLIST,810.114,"PXRMLIST",1)
  1.  ;
  1.  ;Build PXRMFACN/PXRMLOCN array IEN's and counters NHL/NFAC
  1.  D NUM
  1.  ;
  1.  ;Build Service Category array
  1.  I $L(PXRMSCAT)>0 F IC=1:1:$L(PXRMSCAT,",") S PXRMSCAT($P(PXRMSCAT,",",IC))=""
  1.  ;
  1.  ;Add Descriptions for Reminders
  1.  D DES(.PXRMREM,"^PXD(811.9",4)
  1.  ;Add Descriptions for Reminder Categories
  1.  D DES(.PXRMRCAT,"^PXRMD(811.7",4)
  1.  ;Add Descriptions for Teams
  1.  D DES(.PXRMOTM,"^OR(100.21",3)
  1.  ;Add Display Codes for Stops
  1.  D CODE(.PXRMCS,"^DIC(40.7",3)
  1.  ;
  1.  ;Sort Reminders into display order
  1.  D SORT(.PXRMREM,.ORDER)
  1.  ;Sort Reminders categories into display order
  1.  D SORT(.PXRMRCAT,.ORDERC)
  1.  ;
  1.  ;Combine individual reminders and category reminders
  1.  D MERGE^PXRMXS1
  1.  Q
  1.  ;
  1.  ;
  1.  ;Extract INTernal and EXTernal format from ARRAY
  1.  ;-----------------------------------------------
  1. SUB(OUTPUT,SUB,VAR,ORD) ; 
  1.  K OUTPUT
  1.  N IC,INT,EXT,SUB1,DISP
  1.  S SUB1="",IC=0
  1.  F  S SUB1=$O(ARRAY(SUB,SUB1)) Q:SUB1=""  D
  1.  .S INT=$P($G(ARRAY(SUB,SUB1,MREF(VAR),"I")),";")
  1.  .S EXT=$G(ARRAY(SUB,SUB1,MREF(VAR),"E"))
  1.  .S IC=IC+1
  1.  .I ORD=1 S OUTPUT(IC)=INT_U_EXT
  1.  .I ORD'=1 S OUTPUT(IC)=EXT_U_INT
  1.  .I (VAR'="REMINDER")&(VAR'="REMINDER CATEGORY") Q
  1.  .;Get display order
  1.  .S DISP=$G(ARRAY(SUB,SUB1,MREF("DISPLAY ORDER"),"I"))
  1.  .;Store in PXRMREM for display
  1.  .S OUTPUT(IC)=OUTPUT(IC)_U_DISP
  1.  .;Put reminders with no sequence number last
  1.  .I DISP="" S DISP=99
  1.  .;Create order array for sorting entries later
  1.  .I VAR="REMINDER" S ORDER(DISP,IC)=""
  1.  .I VAR="REMINDER CATEGORY" S ORDERC(DISP,IC)=""
  1.  Q
  1.  ;
  1.  ;Build array PXRMFACN and NFAC
  1.  ;-----------------------------
  1. NUM N IC,FACN,FACNAM
  1.  K PXRMLOCN,PXRMCSN,PXRMCGRN,PXRMFACN
  1.  S IC=""
  1.  F  S IC=$O(PXRMFAC(IC)) Q:IC=""  D
  1.  .S FACN=$P(PXRMFAC(IC),U),FACNAM=$P(PXRMFAC(IC),U,2)
  1.  .S PXRMFACN(FACN)=FACNAM_U_FACN,NFAC=IC
  1.  ; Build Array PXRMLOCN and NHL
  1.  N LOCN
  1.  F  S IC=$O(PXRMLCHL(IC)) Q:IC=""  D
  1.  .S LOCN=$P(PXRMLCHL(IC),U,2)
  1.  .S PXRMLOCN(LOCN)=IC,NHL=IC
  1.  ; Build Array PXRMCSN and NCS
  1.  N CSN
  1.  F  S IC=$O(PXRMCS(IC)) Q:IC=""  D
  1.  .S CSN=$P(PXRMCS(IC),U,2)
  1.  .S PXRMCSN(CSN)=IC,NCS=IC
  1.  ; Build Array PXRMCGRN and NCGRP
  1.  N GRPN
  1.  F  S IC=$O(PXRMCGRP(IC)) Q:IC=""  D
  1.  .S GRPN=$P(PXRMCGRP(IC),U,1)
  1.  .S PXRMCGRN(GRPN)=IC,NCGRP=IC
  1.  Q
  1.  ;
  1.  ;Add print name to OUTPUT array
  1.  ;-------------------------------
  1. DES(OUTPUT,GLOB,POSN) ;
  1.  N IC,IEN,DES
  1.  S IC=""
  1.  F  S IC=$O(OUTPUT(IC)) Q:IC=""  D
  1.  .S IEN=$P(OUTPUT(IC),U,1)
  1.  .X "S DES=$P($G("_GLOB_",IEN,0)),U,3)"
  1.  .S $P(OUTPUT(IC),U,POSN)=DES
  1.  Q
  1.  ;
  1.  ;Add stop code to OUTPUT array
  1.  ;-------------------------------
  1. CODE(OUTPUT,GLOB,POSN) ;
  1.  N IC,IEN,CODE
  1.  S IC=""
  1.  F  S IC=$O(OUTPUT(IC)) Q:IC=""  D
  1.  .S IEN=$P(OUTPUT(IC),U,2)
  1.  .X "S CODE=$P($G("_GLOB_",IEN,0)),U,2)"
  1.  .S $P(OUTPUT(IC),U,POSN)=CODE
  1.  Q
  1.  ;
  1.  ;Sort reminders into display order (allow for duplicates)
  1.  ;--------------------------------------------------------
  1. SORT(INPUT,ORDER) ;
  1.  N IC,DISP,OUTPUT,IC1
  1.  S DISP="",IC1=0
  1.  F  S DISP=$O(ORDER(DISP)) Q:DISP=""  D
  1.  .S IC=""
  1.  .F  S IC=$O(ORDER(DISP,IC)) Q:IC=""  D
  1.  ..S IC1=IC1+1,OUTPUT(IC1)=INPUT(IC)
  1.  ; Move results back
  1.  K INPUT M INPUT=OUTPUT
  1.  Q