88 lines
4.1 KiB
Mathematica
88 lines
4.1 KiB
Mathematica
QAOSENTR ;HISC/JES,DAD-ENTER EDIT AN OCCURRENCE ;6/24/93 15:41
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
S HELPYN="W !?5,""Please answer Y(es) or N(o)"""
|
|
ASK ;
|
|
W !!?5,"Do you wish to see list of open occurrences"
|
|
S %=2,DTOUT=0 D YN^DICN D:%=1 ENLOOK G:%=-1 EXIT I %=0 X HELPYN G ASK
|
|
ENTER ;
|
|
W ! K DIC S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select PATIENT: "
|
|
D ^DIC G:Y=-1 EXIT S QANAME=+Y
|
|
DATE ;
|
|
K %DT S %DT="AETX",%DT(0)="-NOW",%DT("A")="Select OCCURRENCE DATE: "
|
|
D ^%DT K %DT G:Y=-1 NOTHERE S QADATE=+Y
|
|
DAGAIN ;
|
|
W !!?5,"Is this the correct date (Y/N)" S %=1,DTOUT=0
|
|
D YN^DICN G:%=2 DATE G:%=-1 EXIT I %=0 X HELPYN G DAGAIN
|
|
W ! K DIC S DIC="^QA(741.1,",DIC(0)="AEMQ",DIC("A")="Select SCREEN: "
|
|
S DIC("S")="I $P(^(0),""^"",4)'=1"
|
|
D ^DIC K DIC W ! G:Y=-1 NOTHERE S QASCRN=+Y
|
|
D ^QAOSENT1 I QAOSQUIT S QAOSQUIT=0 G ENTER
|
|
S QADEAD=0,QADDEAD="" D ISHEDEAD
|
|
I QADDEAD]"" W *7,!!?5,"You cannot enter an occurrence for this patient, who died on ",QADDEAD,".",! G ENTER
|
|
I QADEAD,+^QA(741.1,QASCRN,0)=109 W *7,!!?5,"You cannot enter more than one death for the same patient.",! G ENTER
|
|
K VAIP S DFN=QANAME,VAIP("D")=QADATE\1,VAIP("M")=0 D IN5^VADPT
|
|
K DD,DIC,DINUM,DO S DIC="^QA(741,",DIC(0)="L",DLAYGO=741,X=QANAME
|
|
D FILE^DICN K DIC S (DA,QAOSD0)=+Y
|
|
G:QAOSD0'>0 ENTER
|
|
S DR="1///^S X=QADATE;3///`"_QASCRN_";28///^S X=DT"
|
|
I $D(^DGPM(+VAIP(1),0))#2,QADATE\1'<(VAIP(3)\1) S DR=DR_";.02///`"_+VAIP(1)
|
|
S DIE="^QA(741,",DR=DR_";4",DA=QAOSD0 D ^DIE S SAVEY=$D(Y)
|
|
S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="o"
|
|
S QAUDIT("COMMENT")="OPEN A RECORD"
|
|
D ^QAQAUDIT G:SAVEY ENTER K DR G:($D(DTOUT))!($D(DUOUT)) NOTHERE
|
|
G ASKEDIT
|
|
NOTHERE ;
|
|
W !!?5,"This occurrence has not yet been entered into the system"
|
|
W !?5,"Do you wish to go back to the enter step (Y/N)",*7
|
|
S %=1,DTOUT=0 D YN^DICN G:%=1 ENTER G:%=-1 EXIT I %=0 X HELPYN G NOTHERE
|
|
G EXIT
|
|
ISHEDEAD ;
|
|
S QAOS109=$O(^QA(741.1,"B",109,0)) Q:QAOS109'>0
|
|
F QAWHEN=0:0 S QAWHEN=$O(^QA(741,"AA",QAOS109,QAWHEN)) Q:QAWHEN'>0 S QAPAT=0 D WHODEAD
|
|
Q
|
|
WHODEAD ;
|
|
S QAPAT=$O(^QA(741,"AA",QAOS109,QAWHEN,QANAME,QAPAT)) Q:QAPAT'>0
|
|
I $P(^QA(741,QAPAT,0),"^",11)'=2 S QADEAD=QADEAD+1 I QAWHEN\1<(QADATE\1) S SAVEY=Y,Y=QAWHEN\1 X ^DD("DD") S QADDEAD=Y,Y=SAVEY
|
|
G WHODEAD
|
|
ASKEDIT ;
|
|
W !!?5,"Do you wish to make any corrections to this entry (Y/N)",*7
|
|
S %=2,DTOUT=0 D YN^DICN G:%=2 ASKREVU G:%=1 EDIT G:X=-1 EXIT
|
|
I %=0 X HELPYN G ASKEDIT
|
|
EDIT ;
|
|
W ! S DIE="^QA(741,",DR="1;3;4" D ^DIE
|
|
ASKREVU ;
|
|
W *7,!!?5,"Do you wish to start review process for this entry (Y/N)"
|
|
S %=1,DTOUT=0 D YN^DICN G:%=2 ENTER G:X=-1 EXIT I %=0 X HELPYN G ASKREVU
|
|
REVIEW ;
|
|
D EN1^QAOEDT0 G ENTER
|
|
Q
|
|
EXIT ;
|
|
K ACTIVE,DA,DIC,DIE,DR,DTOUT,DUOUT,DZ,HELPYN,I,III,IV,LINE21,LOC,PRINTEE
|
|
K QAUDIT,QADAT,QADATE,QADEAD,QADDEAD,QAJUL,QANAM,QANAME,QAOS109,QAOSAUDT
|
|
K QAOSOPEN,QAPAT,QASCREEN,QASCRN,QASTOP,QAOSWHAT,QAWHEN,QAWHO,SAVEY
|
|
K SAVY,V,X,Y,%,%DT,%T,C,D0,D1,D2,DI,DIG,DIH,DIPGM,DIU,DIV,DK,DL,QA
|
|
K QAHOLD,QAI,QALINE,QAOSLOC,QACLOSE,QAOSWRD,SAVEX,Y,Z,QAOS,QAOSD0,QAOSD1
|
|
K QAOSDATA,QAOSFDSP,QAOSFIND,QAOSFOND,QAOSLEVL,QAOSLVNO,QAOSMGMT
|
|
K QAOSNEWF,QAOSQUIT,QAOSX,QAOSREVR,QAOFIELD,QAOSNODE,QAOSSERV,QAOSUBDD
|
|
K ^TMP($J,"L")
|
|
D KVAR^VADPT
|
|
Q
|
|
ENLOOK ;
|
|
W ! D WAIT^DICD W ! K ^TMP($J,"L") S LINE21=$Y,QASTOP=0
|
|
F QAWHO=0:0 S QAWHO=$O(^QA(741,"AD",0,QAWHO)) Q:QAWHO'>0 D
|
|
. S LOC=$G(^QA(741,QAWHO,0))
|
|
. Q:LOC'>0 Q:'$D(^DPT(+LOC,0))
|
|
. S QANAM=$P(^DPT(+LOC,0),"^"),QAJUL=$P(LOC,"^",3)
|
|
. S QASCREEN=$S($D(^QA(741.1,+$G(^QA(741,QAWHO,"SCRN")),0))#2:$P(^(0),"^"),1:+^QA(741,QAWHO,"SCRN"))
|
|
. S:$D(Y) SAVY=Y S Y=QAJUL X ^DD("DD") S QADAT=Y S:$D(SAVY) Y=SAVY
|
|
. S ^TMP($J,"L",QANAM,QAJUL,QASCREEN)=QANAM_"^"_QADAT_"^"_QASCREEN
|
|
. Q
|
|
I $O(^TMP($J,"L",""))="" W !?5,"*** NO OPEN OCCURRENCES FOUND ***" Q
|
|
S QANAM=""
|
|
F S QANAM=$O(^TMP($J,"L",QANAM)) Q:QANAM=""!(QASTOP="^") F QAJUL=0:0 S QAJUL=$O(^TMP($J,"L",QANAM,QAJUL)) Q:QAJUL=""!(QASTOP="^") F QASCREEN=0:0 S QASCREEN=$O(^TMP($J,"L",QANAM,QAJUL,QASCREEN)) Q:QASCREEN=""!(QASTOP="^") D
|
|
. S PRINTEE=^TMP($J,"L",QANAM,QAJUL,QASCREEN)
|
|
. W !?5,$P(PRINTEE,"^",1),?30,$P(PRINTEE,"^",2),?50,$P(PRINTEE,"^",3)
|
|
. I $Y>(IOSL+LINE21-3) K DIR S DIR(0)="E" D ^DIR K DIR S QASTOP=$S(Y'>0:"^",1:0) S LINE21=$Y
|
|
. Q
|
|
Q
|