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