QAMEDT5 ;HISC/DAD-EDIT MANUALLY ENROLL A FALL OUT ;2/10/92 07:33
;;1.0;Clinical Monitoring System;;09/13/1993
MONITOR ;
K DIC S DIC="^QA(743,",DIC(0)="AEMNQ",DIC("A")="Select MONITOR: " W ! D ^DIC K DIC G:Y'>0 EXIT S QAMD0=+Y
S QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:""),QAMONE=$S($D(^QA(743,QAMD0,1))#2:^(1),1:"")
I $P(QAMZERO,"^",5)'>0 W !!?5,"*** THIS MONITOR IS STILL UNDER CONSTRUCTION, CANNOT CONTINUE ***",*7 G MONITOR
I $P(QAMONE,"^",5)'>0 W !!?5,"*** THIS MONITOR'S ON/OFF SWITCH IS TURNED OFF, CANNOT CONTINUE ***",*7 G MONITOR
PATIENT ;
K DIC S DIC="^DPT(",DIC(0)="AEMNQZ",DIC("A")="Select PATIENT: ",DIC("W")="D DICW^QAMEDT5" W ! D ^DIC K DIC G:Y'>0 MONITOR S QAMDFN=+Y,QAMDFN(0)=Y(0)
DATE ;
D NOW^%DTC S QAMDT=% K %DT S %DT="ESTX",%DT(0)=-QAMDT,%DT("A")="EVENT DATE: " W !!,%DT("A") R X:DTIME S:('$T)!(X="") X="^" S QAMX1=$E(X) G:QAMX1="^" PATIENT
I QAMX1="?" D HELP^%DTC W !!,"Searching FALL OUT file for this patient/monitor...",! S QAMDFLT=0 D LOOP0 G:QAMFOUND ASKEDIT W !,"No fall outs found for this patient/monitor." G DATE
D ^%DT K %DT G:Y'>0 DATE S QAMEVENT=Y X ^DD("DD") S QAMEVENT(0)=Y
I (QAMEVENT<$S($P(QAMONE,"^",6):$P(QAMONE,"^",6),1:9999999))!(QAMEVENT>$S($P(QAMONE,"^",7):$P(QAMONE,"^",7),1:9999999)) W !!?5,"*** OUTSIDE START/END DATE RANGE OF MONITOR ***",*7
I S Y=$P(QAMONE,"^",6) X ^DD("DD") W !?5,"*** START DATE: ",$S(Y]"":Y,1:"NONE") S Y=$P(QAMONE,"^",7) X ^DD("DD") W " END DATE: ",$S(Y]"":Y,1:"NONE")," ***" G DATE
W !!,"Searching FALL OUT file for this patient/monitor...",! S QAMDFLT=QAMEVENT D LOOP0
I 'QAMFOUND W !,"No fall outs found for this patient/monitor." G ASKADD
ASKEDIT W !!,"Do you want to edit ",$S(QAMFOUND>1:"one of these records",1:"this record")
S %=1 D YN^DICN G ASKADD:(%=2)&(QAMX1'="?"),DATE:(%=2)&(QAMX1="?"),PATIENT:%=-1 I '% W !!?5,"Please answer Y(es) or N(o)" G ASKEDIT
I QAMFOUND=1 S QAMREC=$P(QAMLIST,"^",2) G EDIT
ASKREC R !!,"Record number: ",QAMREC:DTIME S:('$T)!(QAMREC="") QAMREC="^" G PATIENT:$E(QAMREC)="^",EDIT:QAMLIST[("^"_QAMREC_"^") W:$E(QAMREC)'="?" " ??",*7
W !!,"Enter the record number you wish to edit.",! D LOOP0 G ASKREC
ASKADD W !!,*7,"Are you adding:" S DFN=QAMDFN D PID^VADPT6
W !?3,$P(QAMDFN(0),"^"),?38,VA("PID"),?58,QAMEVENT(0),!?3,$P(QAMZERO,"^",2),?38,$P(QAMZERO,"^"),$S($P(QAMZERO,"^",4):" (a)",1:" (m)"),!,"as a new Fall Out record"
S %=0 D YN^DICN G PATIENT:(%=2)!(%=-1)!((%=0)&(%Y="")) I '% W !!?5,"Please answer Y(es) or N(o)" G ASKADD
K DD,DIC,DINUM,DO S DIC="^QA(743.1,",DIC(0)="LM",DIC("DR")=".02///`"_QAMD0_";.03///"_QAMEVENT_";.04///TODAY",DLAYGO=743.1,X=QAMDFN D FILE^DICN K DIC S QAMREC=+Y,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="MANUAL ENROLLED FALL OUT" D AUDIT^QAMEDT5A
EDIT ;
D ^QAMEDT5A G PATIENT
EXIT ;
K %,%DT,DA,DIC,DIE,DLAYGO,DR,QA,QAMD0,QAMD1,QAMDFN,QAMDT,QAMEVENT,QAMFOUND,QAMONE,QAMREC,QAMZERO,X,Y,QAMDFLT,QAMLIST,QAMX1,D0,D1,DA,DTOUT,DIRUT,QAM,QAMFLD,QAMIEN,QAMPCENT,QAMQUIT,QAMXFORM
K %Y,DIQ,MAX,QADA,QAMDA,QAMDD,QAMDTPT,QAME1,QAMELEM,QAMFIELD,QAMLEVL,QAMDIR,DFN,VA,DGT,DI,DQ,QADIROUT,QADIRPNT,QAMID,QAMIDENT,QAMY,VAERR
Q
LOOP0 S QAMFOUND=0,QAMLIST="^" F QAMDT=(QAMDFLT\1-.0000001):0 S QAMDT=$O(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT)) Q:QAMDT'>0 Q:(QAMDT\1'=(QAMDFLT\1))&QAMDFLT D LOOP1
Q
LOOP1 F QAMD1=0:0 S QAMD1=$O(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT,QAMD1)) Q:QAMD1'>0 S QAMFOUND=QAMFOUND+1,Y=QAMDT,QAMLIST=QAMLIST_QAMD1_"^" X ^DD("DD") W !?5,QAMD1,?15,Y
Q
DICW S QAMY=+Y,QAMID="" N Y F QAMID(0)=0:0 S QAMID=$O(^DD(2,0,"ID",QAMID)) Q:QAMID="" S Y=QAMY,QAMIDENT=^DD(2,0,"ID",QAMID),QAM=$S($D(^DPT(QAMY,0))#2:^(0),1:"") Q:QAM="" X QAMIDENT
Q:'$D(^QA(743.1,"B",QAMY)) N DIC S DIC="^QA(743.1," W !?7,"*** FALL OUTS ***"
F QA=0:0 S QA=$O(^QA(743.1,"B",QAMY,QA)) Q:QA'>0 W !?5 S QAMID="" F QAMID(0)=0:0 S QAMID=$O(^DD(743.1,0,"ID",QAMID)) Q:QAMID="" S Y=QA,QAMIDENT=^DD(743.1,0,"ID",QAMID),QAM=$S($D(^QA(743.1,QA,0))#2:^(0),1:"") Q:QAM="" X QAMIDENT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMEDT5 3946 printed Sep 23, 2025@19:18:21 Page 2
QAMEDT5 ;HISC/DAD-EDIT MANUALLY ENROLL A FALL OUT ;2/10/92 07:33
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
MONITOR ;
+1 KILL DIC
SET DIC="^QA(743,"
SET DIC(0)="AEMNQ"
SET DIC("A")="Select MONITOR: "
WRITE !
DO ^DIC
KILL DIC
if Y'>0
GOTO EXIT
SET QAMD0=+Y
+2 SET QAMZERO=$SELECT($DATA(^QA(743,QAMD0,0))#2:^(0),1:"")
SET QAMONE=$SELECT($DATA(^QA(743,QAMD0,1))#2:^(1),1:"")
+3 IF $PIECE(QAMZERO,"^",5)'>0
WRITE !!?5,"*** THIS MONITOR IS STILL UNDER CONSTRUCTION, CANNOT CONTINUE ***",*7
GOTO MONITOR
+4 IF $PIECE(QAMONE,"^",5)'>0
WRITE !!?5,"*** THIS MONITOR'S ON/OFF SWITCH IS TURNED OFF, CANNOT CONTINUE ***",*7
GOTO MONITOR
PATIENT ;
+1 KILL DIC
SET DIC="^DPT("
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select PATIENT: "
SET DIC("W")="D DICW^QAMEDT5"
WRITE !
DO ^DIC
KILL DIC
if Y'>0
GOTO MONITOR
SET QAMDFN=+Y
SET QAMDFN(0)=Y(0)
DATE ;
+1 DO NOW^%DTC
SET QAMDT=%
KILL %DT
SET %DT="ESTX"
SET %DT(0)=-QAMDT
SET %DT("A")="EVENT DATE: "
WRITE !!,%DT("A")
READ X:DTIME
if ('$TEST)!(X="")
SET X="^"
SET QAMX1=$EXTRACT(X)
if QAMX1="^"
GOTO PATIENT
+2 IF QAMX1="?"
DO HELP^%DTC
WRITE !!,"Searching FALL OUT file for this patient/monitor...",!
SET QAMDFLT=0
DO LOOP0
if QAMFOUND
GOTO ASKEDIT
WRITE !,"No fall outs found for this patient/monitor."
GOTO DATE
+3 DO ^%DT
KILL %DT
if Y'>0
GOTO DATE
SET QAMEVENT=Y
XECUTE ^DD("DD")
SET QAMEVENT(0)=Y
+4 IF (QAMEVENT<$SELECT($PIECE(QAMONE,"^",6):$PIECE(QAMONE,"^",6),1:9999999))!(QAMEVENT>$SELECT($PIECE(QAMONE,"^",7):$PIECE(QAMONE,"^",7),1:9999999))
WRITE !!?5,"*** OUTSIDE START/END DATE RANGE OF MONITOR ***",*7
+5 IF $TEST
SET Y=$PIECE(QAMONE,"^",6)
XECUTE ^DD("DD")
WRITE !?5,"*** START DATE: ",$SELECT(Y]"":Y,1:"NONE")
SET Y=$PIECE(QAMONE,"^",7)
XECUTE ^DD("DD")
WRITE " END DATE: ",$SELECT(Y]"":Y,1:"NONE")," ***"
GOTO DATE
+6 WRITE !!,"Searching FALL OUT file for this patient/monitor...",!
SET QAMDFLT=QAMEVENT
DO LOOP0
+7 IF 'QAMFOUND
WRITE !,"No fall outs found for this patient/monitor."
GOTO ASKADD
ASKEDIT WRITE !!,"Do you want to edit ",$SELECT(QAMFOUND>1:"one of these records",1:"this record")
+1 SET %=1
DO YN^DICN
if (%=2)&(QAMX1'="?")
GOTO ASKADD
if (%=2)&(QAMX1="?")
GOTO DATE
if %=-1
GOTO PATIENT
IF '%
WRITE !!?5,"Please answer Y(es) or N(o)"
GOTO ASKEDIT
+2 IF QAMFOUND=1
SET QAMREC=$PIECE(QAMLIST,"^",2)
GOTO EDIT
ASKREC READ !!,"Record number: ",QAMREC:DTIME
if ('$TEST)!(QAMREC="")
SET QAMREC="^"
if $EXTRACT(QAMREC)="^"
GOTO PATIENT
if QAMLIST[("^"_QAMREC_"^")
GOTO EDIT
if $EXTRACT(QAMREC)'="?"
WRITE " ??",*7
+1 WRITE !!,"Enter the record number you wish to edit.",!
DO LOOP0
GOTO ASKREC
ASKADD WRITE !!,*7,"Are you adding:"
SET DFN=QAMDFN
DO PID^VADPT6
+1 WRITE !?3,$PIECE(QAMDFN(0),"^"),?38,VA("PID"),?58,QAMEVENT(0),!?3,$PIECE(QAMZERO,"^",2),?38,$PIECE(QAMZERO,"^"),$SELECT($PIECE(QAMZERO,"^",4):" (a)",1:" (m)"),!,"as a new Fall Out record"
+2 SET %=0
DO YN^DICN
if (%=2)!(%=-1)!((%=0)&(%Y=""))
GOTO PATIENT
IF '%
WRITE !!?5,"Please answer Y(es) or N(o)"
GOTO ASKADD
+3 KILL DD,DIC,DINUM,DO
SET DIC="^QA(743.1,"
SET DIC(0)="LM"
SET DIC("DR")=".02///`"_QAMD0_";.03///"_QAMEVENT_";.04///TODAY"
SET DLAYGO=743.1
SET X=QAMDFN
DO FILE^DICN
KILL DIC
SET QAMREC=+Y
SET QAUDIT("ACTION")="o"
SET QAUDIT("COMMENT")="MANUAL ENROLLED FALL OUT"
DO AUDIT^QAMEDT5A
EDIT ;
+1 DO ^QAMEDT5A
GOTO PATIENT
EXIT ;
+1 KILL %,%DT,DA,DIC,DIE,DLAYGO,DR,QA,QAMD0,QAMD1,QAMDFN,QAMDT,QAMEVENT,QAMFOUND,QAMONE,QAMREC,QAMZERO,X,Y,QAMDFLT,QAMLIST,QAMX1,D0,D1,DA,DTOUT,DIRUT,QAM,QAMFLD,QAMIEN,QAMPCENT,QAMQUIT,QAMXFORM
+2 KILL %Y,DIQ,MAX,QADA,QAMDA,QAMDD,QAMDTPT,QAME1,QAMELEM,QAMFIELD,QAMLEVL,QAMDIR,DFN,VA,DGT,DI,DQ,QADIROUT,QADIRPNT,QAMID,QAMIDENT,QAMY,VAERR
+3 QUIT
LOOP0 SET QAMFOUND=0
SET QAMLIST="^"
FOR QAMDT=(QAMDFLT\1-.0000001):0
SET QAMDT=$ORDER(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT))
if QAMDT'>0
QUIT
if (QAMDT\1'=(QAMDFLT\1))&QAMDFLT
QUIT
DO LOOP1
+1 QUIT
LOOP1 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT,QAMD1))
if QAMD1'>0
QUIT
SET QAMFOUND=QAMFOUND+1
SET Y=QAMDT
SET QAMLIST=QAMLIST_QAMD1_"^"
XECUTE ^DD("DD")
WRITE !?5,QAMD1,?15,Y
+1 QUIT
DICW SET QAMY=+Y
SET QAMID=""
NEW Y
FOR QAMID(0)=0:0
SET QAMID=$ORDER(^DD(2,0,"ID",QAMID))
if QAMID=""
QUIT
SET Y=QAMY
SET QAMIDENT=^DD(2,0,"ID",QAMID)
SET QAM=$SELECT($DATA(^DPT(QAMY,0))#2:^(0),1:"")
if QAM=""
QUIT
XECUTE QAMIDENT
+1 if '$DATA(^QA(743.1,"B",QAMY))
QUIT
NEW DIC
SET DIC="^QA(743.1,"
WRITE !?7,"*** FALL OUTS ***"
+2 FOR QA=0:0
SET QA=$ORDER(^QA(743.1,"B",QAMY,QA))
if QA'>0
QUIT
WRITE !?5
SET QAMID=""
FOR QAMID(0)=0:0
SET QAMID=$ORDER(^DD(743.1,0,"ID",QAMID))
if QAMID=""
QUIT
SET Y=QA
SET QAMIDENT=^DD(743.1,0,"ID",QAMID)
SET QAM=$SELECT($DATA(^QA(743.1,QA,0))#2:^(0),1:"")
if QAM=""
QUIT
XECUTE QAMIDENT
+3 QUIT
