- 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 Mar 13, 2025@20:47:02 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
