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

APCDSWM.m

Go to the documentation of this file. 
  1. APCDSWM ; IHS/CMI/LAB - SWITCH TO V FILE ;
  1.  ;;2.0;IHS PCC SUITE;**4,5,10**;MAY 14, 2009;Build 88
  1.  ;
  1.  ; APCDSWD=DICTIONARY NUMBER
  1.  ; APCDSWCR=LINKING CROSS REFERENCE
  1.  ; APCDSWV=VISIT DFN
  1.  ;
  1. EPLKW ;EP
  1.  NEW APCDSWMT
  1.  S APCDSWMT="LKW"
  1.  D EP
  1.  K APCDSWMV
  1.  Q
  1. EP ;EP
  1.  D EN^XBNEW("EN^APCDSWM","APCDVSIT;APCDMNE;APCDSWMV;APCDSWMT")
  1.  Q
  1. EN ;
  1.  NEW APCDSWDA,APCDSWMV,APCDVM01,APCDVM04,APCDSWCT,APCDSWA,APCDSWAN,APCDSWX,APCDSWT,APCDSWI
  1.  NEW X,Y,DIR
  1. EN0 ;
  1.  W !!,"Please Note:  You are NOT permitted to modify or delete a measurement."
  1.  W !,"A measurement must be marked as 'entered in error' and then re-entered "
  1.  W !,"through Add or Append mode of PCC data entry."
  1.  ;
  1.  S APCDSWCT=0
  1.  K APCDSWA
  1.  ;S APCDSWMV=$P($G(^APCDTKW(APCDMNE,0)),U,5),APCDSWMV=$TR(APCDSWMV,"""","")
  1.  S APCDSWDA=0 F  S APCDSWDA=$O(^AUPNVMSR("AD",APCDVSIT,APCDSWDA)) Q:APCDSWDA'=+APCDSWDA  D
  1.  .Q:$P($G(^AUPNVMSR(APCDSWDA,2)),U,1)  ;don't display those entered in error
  1.  .S APCDVM01=$$VAL^XBDIQ1(9000010.01,APCDSWDA,.01)
  1.  .;S APCDVM04=$$VAL^XBDIQ1(9000010.04,APCDSWDA,.04)
  1.  .I $G(APCDSWMT)]"",APCDVM01'=APCDSWMT Q
  1.  .S APCDSWCT=APCDSWCT+1
  1.  .S APCDSWA(APCDSWCT)=APCDSWDA
  1.  I '$D(APCDSWA) W !!,"There are no ",$S($G(APCDSWMV)]"":APCDSWMV_" ",1:""),"measurements on this visit." Q
  1.  D SELECTM
  1.  Q
  1.  ;
  1. SELECTM ;
  1.  ;select the measurement to edit or delete
  1.  W !,"Please choose which measurement you would like to mark 'Entered in Error',"
  1.  W !,"if you do not wish to mark any in error, simply press 'enter' to bypass."
  1.  S APCDSWX=0,APCDSWT=0 F  S APCDSWX=$O(APCDSWA(APCDSWX)) Q:APCDSWX'=+APCDSWX  D
  1.  .S APCDSWDA=APCDSWA(APCDSWX),APCDSWT=APCDSWX
  1.  .S APCDVM01=$$VAL^XBDIQ1(9000010.01,APCDSWDA,.01)
  1.  .S APCDVM04=$$VAL^XBDIQ1(9000010.01,APCDSWDA,.04)
  1.  .W !?2,APCDSWX,")",?7,APCDVM01,?14,APCDVM04
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDSWT_":0",DIR("A")="Which Measurement",DIR("?")="Enter a number from the list above (1-"_APCDSWT_" or 'N' to exit." KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I X="" Q
  1.  I Y="" Q
  1.  I '$D(APCDSWA(X)) W !,"Invalid response.  Please enter a number from 1 to ",APCDSWT," or N." G SELECTM
  1.  S APCDSWI=Y
  1.  S APCDSWDA=APCDSWA(X)
  1.  K DIR
  1.  W !,"You have selected: ",$$VAL^XBDIQ1(9000010.01,APCDSWDA,.01),"   Value: ",$$VAL^XBDIQ1(9000010.01,APCDSWDA,.04)
  1.  S DIR(0)="Y",DIR("A")="Are you sure you want to mark this measurement entered in error",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  Q:'Y
  1.  Q:$D(DIRUT)
  1.  D ENTINERR(APCDSWDA)
  1.  Q
  1. ENTINERR(APCDSWDA) ;EP
  1.  I '$D(APCDSWDA) Q
  1.  I '$D(^AUPNVMSR(APCDSWDA,0)) W !!,"invalid v measurement...." Q
  1.  W !,"Please enter the reason the measurement was entered in error.  Choices are:"
  1.  W !?10,"1    INCORRECT DATE/TIME"
  1.  W !?10,"2    INCORRECT READING"
  1.  W !?10,"3    INCORRECT PATIENT"
  1.  W !?10,"4    INVALID RECORD"
  1.  S DA=APCDSWDA,DIE("NO^")=1,DIE="^AUPNVMSR(",DR="[APCD MEAS ENTERED IN ERROR]" D ^DIE K DA,DR,DIE
  1.  S T=$$GET1^DIQ(9000010.01,APCDSWDA,.01)
  1.  I T="WT"!(T="HT") D EIE^APCDBMI(APCDSWDA) Q  ;DELETE BMI AND BMIP on this visit that were from this WT
  1.  Q
  1. MODQUAL ;
  1.  I '$D(APCDSWDA) Q
  1.  I '$D(^AUPNVMSR(APCDSWDA,0)) W !!,"invalid v measurement...." Q
  1.  S DA=APCDSWDA,DIE="^AUPNVMSR(",DR=5 D ^DIE K DA,DR,DIE
  1.  Q
  1. EPCOAG ;EP
  1.  D EN^XBNEW("ENCOAG^APCDSWM","APCDVSIT;APCDMNE;APCDSWMV;APCDSWMT")
  1.  Q
  1. ENCOAG ;
  1.  NEW APCDSWDA,APCDSWMV,APCDVM01,APCDVM04,APCDSWCT,APCDSWA,APCDSWAN,APCDSWX,APCDSWT,APCDSWI
  1.  NEW X,Y,DIR
  1. EN0COAG ;
  1.  W !!,"Please Note:  You are NOT permitted to edit/delete an Anti-Coagulation entry."
  1.  W !,"It can only marked as 'entered in error'."
  1.  ;
  1.  S APCDSWCT=0
  1.  K APCDSWA
  1.  S APCDSWDA=0 F  S APCDSWDA=$O(^AUPNVACG("AD",APCDVSIT,APCDSWDA)) Q:APCDSWDA'=+APCDSWDA  D
  1.  .Q:$P($G(^AUPNVACG(APCDSWDA,1)),U,1)  ;don't display those entered in error
  1.  .S APCDVM01=$$VAL^XBDIQ1(9000010.51,APCDSWDA,.01)
  1.  .S APCDVM04=$$VAL^XBDIQ1(9000010.51,APCDSWDA,.04)
  1.  .I $G(APCDSWMT)]"",APCDVM01'=APCDSWMT Q
  1.  .S APCDSWCT=APCDSWCT+1
  1.  .S APCDSWA(APCDSWCT)=APCDSWDA
  1.  I '$D(APCDSWA) W !!,"There are no ",$S($G(APCDSWMV)]"":APCDSWMV_" ",1:""),"Anti-Coag entries on this visit." Q
  1.  D SELECTC
  1.  Q
  1.  ;
  1. SELECTC ;
  1.  ;select the entry to delete
  1.  W !,"Please choose which anti-coagulation entry you would like to mark 'Entered"
  1.  W !,"in Error',if you do not wish to mark any in error, simply press 'enter' to ",!,"bypass."
  1.  S APCDSWX=0,APCDSWT=0 F  S APCDSWX=$O(APCDSWA(APCDSWX)) Q:APCDSWX'=+APCDSWX  D
  1.  .S APCDSWDA=APCDSWA(APCDSWX),APCDSWT=APCDSWX
  1.  .S APCDVM01=$$VAL^XBDIQ1(9000010.51,APCDSWDA,.01)
  1.  .S APCDVM04=$$VAL^XBDIQ1(9000010.51,APCDSWDA,.04)
  1.  .W !?2,APCDSWX,")",?7,APCDVM01,?14,APCDVM04
  1.  K DIR
  1.  W !
  1.  S DIR(0)="NO^1:"_APCDSWT_":0",DIR("A")="Which Entry",DIR("?")="Enter a number from the list above (1-"_APCDSWT_" or 'N' to exit." KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I X="" Q
  1.  I Y="" Q
  1.  I '$D(APCDSWA(X)) W !,"Invalid response.  Please enter a number from 1 to ",APCDSWT," or N." G SELECTM
  1.  S APCDSWI=Y
  1.  S APCDSWDA=APCDSWA(X)
  1.  K DIR
  1.  W !,"You have selected: ",$$VAL^XBDIQ1(9000010.51,APCDSWDA,.01),"   INR GOAL: ",$$VAL^XBDIQ1(9000010.51,APCDSWDA,.04)
  1.  S DIR(0)="Y",DIR("A")="Are you sure you want to mark this entry entered in error",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  Q:'Y
  1.  Q:$D(DIRUT)
  1.  D COAGERR(APCDSWDA)
  1.  Q
  1. COAGERR(APCDSWDA) ;EP
  1.  I '$D(APCDSWDA) Q
  1.  I '$D(^AUPNVACG(APCDSWDA,0)) W !!,"invalid v anti-coagt...." Q
  1.  W !,"Please enter the reason the entry was entered in error.  Choices are:"
  1.  W !?10,"D    DUPLICATE"
  1.  W !?10,"E    ENTERED IN ERROR"
  1.  W !?10,"O    OTHER"
  1.  S DA=APCDSWDA,DIE("NO^")=1,DIE="^AUPNVACG(",DR="[APCD COAG ENTERED IN ERROR]" D ^DIE K DA,DR,DIE
  1.  Q