source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMEDT5.m@ 1427

Last change on this file since 1427 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1QAMEDT5 ;HISC/DAD-EDIT MANUALLY ENROLL A FALL OUT ;2/10/92 07:33
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3MONITOR ;
4 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
5 S QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:""),QAMONE=$S($D(^QA(743,QAMD0,1))#2:^(1),1:"")
6 I $P(QAMZERO,"^",5)'>0 W !!?5,"*** THIS MONITOR IS STILL UNDER CONSTRUCTION, CANNOT CONTINUE ***",*7 G MONITOR
7 I $P(QAMONE,"^",5)'>0 W !!?5,"*** THIS MONITOR'S ON/OFF SWITCH IS TURNED OFF, CANNOT CONTINUE ***",*7 G MONITOR
8PATIENT ;
9 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)
10DATE ;
11 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
12 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
13 D ^%DT K %DT G:Y'>0 DATE S QAMEVENT=Y X ^DD("DD") S QAMEVENT(0)=Y
14 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
15 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
16 W !!,"Searching FALL OUT file for this patient/monitor...",! S QAMDFLT=QAMEVENT D LOOP0
17 I 'QAMFOUND W !,"No fall outs found for this patient/monitor." G ASKADD
18ASKEDIT W !!,"Do you want to edit ",$S(QAMFOUND>1:"one of these records",1:"this record")
19 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
20 I QAMFOUND=1 S QAMREC=$P(QAMLIST,"^",2) G EDIT
21ASKREC R !!,"Record number: ",QAMREC:DTIME S:('$T)!(QAMREC="") QAMREC="^" G PATIENT:$E(QAMREC)="^",EDIT:QAMLIST[("^"_QAMREC_"^") W:$E(QAMREC)'="?" " ??",*7
22 W !!,"Enter the record number you wish to edit.",! D LOOP0 G ASKREC
23ASKADD W !!,*7,"Are you adding:" S DFN=QAMDFN D PID^VADPT6
24 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"
25 S %=0 D YN^DICN G PATIENT:(%=2)!(%=-1)!((%=0)&(%Y="")) I '% W !!?5,"Please answer Y(es) or N(o)" G ASKADD
26 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
27EDIT ;
28 D ^QAMEDT5A G PATIENT
29EXIT ;
30 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
31 K %Y,DIQ,MAX,QADA,QAMDA,QAMDD,QAMDTPT,QAME1,QAMELEM,QAMFIELD,QAMLEVL,QAMDIR,DFN,VA,DGT,DI,DQ,QADIROUT,QADIRPNT,QAMID,QAMIDENT,QAMY,VAERR
32 Q
33LOOP0 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
34 Q
35LOOP1 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
36 Q
37DICW 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
38 Q:'$D(^QA(743.1,"B",QAMY)) N DIC S DIC="^QA(743.1," W !?7,"*** FALL OUTS ***"
39 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
40 Q
Note: See TracBrowser for help on using the repository browser.