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

MMRSIPCP.m

Go to the documentation of this file.
  1. MMRSIPCP ;MIA/LMT/TCK,LAB - SETUP MDRO TOOLS SOFTWARE PARAMETERS ;May 22, 2019@09:15:23
  1. ;;1.0;MRSA PROGRAM TOOLS;**1,3,4,8,9**;Mar 22, 2009;Build 1
  1. ;
  1. DIV ;Add a division and setup business rules
  1. N DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
  1. S DIC="^MMRS(104,"
  1. S DIC(0)="AELMQ"
  1. S DIC("A")="Select MRSA Site Parameters Division: "
  1. S DLAYGO=104
  1. D ^DIC
  1. K DLAYGO
  1. I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
  1. S MMRSDIV=+Y
  1. W !!
  1. ;RECEIVING UNIT SCREEN
  1. S DA=MMRSDIV
  1. S DIR("A")="1. Receiving unit screen on unit-to-unit transfers"
  1. S DIR(0)="104,1"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. S DIE="^MMRS(104,"
  1. S DA=MMRSDIV
  1. S Y=+$P(Y,U,1)
  1. S DR="1///"_Y ;MMRS*1.0*8
  1. I Y=1!(Y=0) D ^DIE
  1. ;DISCHARGING UNIT SCREEN
  1. S DA=MMRSDIV
  1. S DIR("A")="2. Discharging unit screen on unit-to-unit transfers"
  1. S DIR(0)="104,2"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. S DIE="^MMRS(104,"
  1. S DA=MMRSDIV
  1. S Y=+$P(Y,U,1)
  1. S DR="2///"_Y ;MMRS*1.0*8
  1. I Y=1!(Y=0) D ^DIE
  1. ;SCREEN POS ON TRANSFER IN
  1. S DA=MMRSDIV
  1. S DIR("A")="3. Screen patients with MRSA history on transfer-in"
  1. S DIR(0)="104,3"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. S DIE="^MMRS(104,"
  1. S DA=MMRSDIV
  1. S Y=+$P(Y,U,1)
  1. S DR="3///"_Y ;MMRS*1.0*8
  1. I Y=1!(Y=0) D ^DIE
  1. ;SCREEN POS ON DISCHARGE
  1. S DA=MMRSDIV
  1. S DIR("A")="4. Screen patients with MRSA history on discharge/death/transfer-out"
  1. S DIR(0)="104,4"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. S DIE="^MMRS(104,"
  1. S DA=MMRSDIV
  1. S Y=+$P(Y,U,1)
  1. S DR="4///"_Y ;MMRS*1.0*8
  1. I Y=1!(Y=0) D ^DIE
  1. Q
  1. ;
  1. FLESPC ;
  1. ;Add a division and setup business rules
  1. N DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
  1. S DIC="^MMRS(104,"
  1. S DIC(0)="AELMQ"
  1. S DIC("A")="Select CRE Site Parameters Division: "
  1. S DLAYGO=104
  1. D ^DIC
  1. K DLAYGO
  1. I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
  1. S MMRSDIV=+Y
  1. W !!
  1. ;ADD SURVEILLANCE SCREEN SPECIMENS
  1. N STID,STNM,SIEN
  1. S DIR(0)="YA",DIR("A")="Do you want to Add or Edit specimen(s) for CRE Surveillance Screens"
  1. S DIR(0)="S^A:ADD;E:EDIT"
  1. S DIR("B")="E"
  1. D ^DIR
  1. Q:X=""!($D(DIRUT))!($D(DIROUT))
  1. ;I $D(DIRUT) S EXTFLG=1 Q
  1. I Y Q
  1. S STOP=0
  1. N DIC,DLAYGO,DTOUT,DUOUT,EXTFLG
  1. S EXTFLG=0
  1. G:Y="A" ADD
  1. ;
  1. DEL ;
  1. S EXTFLG=0
  1. W !
  1. S DA(1)=MMRSDIV
  1. K DIR S DIR("A")="Select Specimen to delete"
  1. S DIR("?")="Enter the specimen you want to edit"
  1. S DIR(0)="PO^MMRS(104,DA(1),61,:QEMO"
  1. D ^DIR
  1. I Y["^" D
  1. .S DA(1)=MMRSDIV
  1. .S DA=$P(Y,"^")
  1. .S DIK="^MMRS(104,"_DA(1)_",61,"
  1. .D ^DIK
  1. I $P(Y,"^",2)'="" G DEL
  1. K DIK,DA
  1. Q
  1. ;
  1. ADD ;
  1. K DIR S DIR("A")="Select Specimen"
  1. S DIR(0)="P^61:QEM"
  1. S DA(1)=MMRSDIV
  1. D ^DIR
  1. I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
  1. S X=$P(Y,"^"),VAL=X
  1. I $D(^MMRS(104,"AC",DA(1),X)) D G FLESPC
  1. .W !!!!,$P(Y,"^",2)_" already exists." H 1 Q
  1. S IEN="?+1,"_DA(1)_","
  1. S LRFDA(61,104.0216061,IEN,.01)=VAL
  1. D UPDATE^DIE("","LRFDA(61)","","LRMSG")
  1. I 'EXTFLG G FLESPC
  1. Q
  1. ;
  1. ;
  1. LAB ;Entry to setup the Lab Search/Extract Parameters
  1. N EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DDSFILE,DR,DDSPAGE,DDSPARAM,DIR
  1. D CHECK^MMRSIPC
  1. I $D(EXTFLG) W ! H 2 Q
  1. W !
  1. S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
  1. W !
  1. S MDRO=$$GETMDRO Q:$D(EXTFLG)
  1. W !
  1. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to see a description for "_$$GET1^DIQ(104.2,MDRO,.01)
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. I Y=1 D
  1. .N DIC,DA,DR,DIQ,DIR
  1. .W @IOF
  1. .S DIC="^MMRS(104.2,"
  1. .S DA=MDRO
  1. .S DR=2
  1. .D EN^DIQ
  1. .S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
  1. W !
  1. S DA=$O(^MMRS(104.1,"C",MMRSDIV,MDRO,0))
  1. I 'DA D Q:$D(EXTFLG)!('DA)
  1. .K DA
  1. .S DIC="^MMRS(104.1,"
  1. .S DIC(0)="F"
  1. .S X=MDRO
  1. .S DIC("DR")="1////"_MMRSDIV ;MMRS*1.0*9
  1. .D FILE^DICN
  1. .I Y=-1 S EXTFLG=1 Q
  1. .S DA=+Y
  1. S DDSFILE="^MMRS(104.1,"
  1. S DR="[MMRSLABPARAM]"
  1. D ^DDS
  1. Q
  1. GETMDRO() ;
  1. N MDRO,DIC,DLAYGO,DINUM,Y,DLAYGO,X,DTOUT,DUOUT
  1. S MDRO=""
  1. S DIC="^MMRS(104.2,"
  1. S DIC(0)="AEMNQ"
  1. S DIC("A")="Select the MDRO: "
  1. D ^DIC K DIC
  1. I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q ""
  1. S MDRO=+Y
  1. Q MDRO
  1. WARDMAP ;Entry to setup the Ward Mappings
  1. N MMRSDIV,DIC,Y,DLAYGO,DINUM,X,DTOUT,DUOUT,DDSFILE,DR,DA,DDSPAGE,DDSPARAM,EXTFLG,DIE,DIDEL,MMRSDA
  1. D CHECK^MMRSIPC
  1. I $D(EXTFLG) W ! H 2 Q
  1. W !
  1. S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
  1. F Q:$D(EXTFLG) D
  1. .S DIC="^MMRS(104.3,"
  1. .S DIC(0)="AELMQ"
  1. .S DIC("A")="Select Geographical Unit: "
  1. .S DIC("DR")="1////"_MMRSDIV_";3;4" ;MMRS*1.0*9
  1. .S DLAYGO=104.3
  1. .W !! D ^DIC
  1. .K DLAYGO
  1. .I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
  1. .S MMRSDA=+Y
  1. .I '$P(Y,U,3) D
  1. ..S DIE="^MMRS(104.3,"
  1. ..S DA=MMRSDA
  1. ..S DR=".01;3;4"
  1. ..S DIDEL=104.3
  1. ..W !
  1. ..D ^DIE
  1. ..I $D(DTOUT)!('$D(DA)) S EXTFLG=1 Q
  1. .Q:$D(EXTFLG)
  1. .S DDSFILE="^MMRS(104.3,"
  1. .S DR="[MMRSMRSA WARD MAP]"
  1. .S DA=MMRSDA
  1. .D ^DDS
  1. .W @IOF
  1. Q
  1. HISTDAY ;Historical Days Edit
  1. N EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DIR,NUMDAY,MMRSX,DIE,DR,DIDEL,DIRUT,DTOUT,DUOUT
  1. D CHECK^MMRSIPC
  1. I $D(EXTFLG) W ! H 2 Q
  1. W ! S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
  1. W !
  1. S MDRO=0 F S MDRO=$O(^MMRS(104.2,MDRO)) Q:'MDRO D Q:$D(EXTFLG)
  1. .S DA=$O(^MMRS(104.2,MDRO,1,"B",MMRSDIV,0))
  1. .I 'DA D Q:$D(EXTFLG)!('DA)
  1. ..K DA
  1. ..S DIC="^MMRS(104.2,"_MDRO_",1,"
  1. ..S DIC(0)="F"
  1. ..S DA(1)=MDRO
  1. ..S X=MMRSDIV
  1. ..D FILE^DICN
  1. ..I Y=-1 S EXTFLG=1 Q
  1. ..S DA=+Y
  1. .S DA(1)=MDRO
  1. .S DIR(0)="104.22,1^AO"
  1. .S DIR("PRE")="I X=""@"" S X=9876 S MMRSX=9876"
  1. .S DIR("A")="Enter the number of days to search for "_$P($G(^MMRS(104.2,MDRO,0)),U,1)
  1. .D ^DIR
  1. .I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
  1. .I Y D
  1. ..S DIE="^MMRS(104.2,"_MDRO_",1,"
  1. ..I $G(MMRSX)'=9876 S DR="1///"_+Y ;MMRS*1.0*8
  1. ..I Y=9876,($G(MMRSX)=9876) S DR="1////@"
  1. ..K MMRSX
  1. ..D ^DIE
  1. ..I $D(Y) S EXTFLG=1 Q ;MMRS*1.0*8
  1. W !
  1. Q
  1. ISLTORD ;Entry to setup the Isolation Orders Parameters
  1. N EXTFLG,MMRSDIV,DA,DDSFILE,DR,DDSPAGE,DDSPARAM
  1. D CHECK^MMRSIPC
  1. I $D(EXTFLG) W ! H 2 Q
  1. W !
  1. S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
  1. W !
  1. S DA=MMRSDIV
  1. S DDSFILE="^MMRS(104,"
  1. S DR="[MMRSISLTORD]"
  1. D ^DDS
  1. Q