35 lines
2.6 KiB
Mathematica
35 lines
2.6 KiB
Mathematica
QAOSPAD0 ;HISC/DAD-ADVERSE FINDINGS REPORT ;6/11/93 15:54
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
W !!,"Do you want the report to include the (N)ames/(C)odes of the ATTENDING PHYSICIAN",!,"RESIDENT/PROVIDER, MEDICAL TEAM, and ATTRIBUTIONs, or none (X) of the above?",!
|
|
ASK R !,"CHOOSE (N/C/X): N// ",X:DTIME S:'$T X="^" S:X="" X="N" S X=$E(X) G:X="^" EXIT S:X?1L X=$C($A(X)-32) S QAOSCHOS=X
|
|
I (X'="N")&(X'="C")&(X'="X") W:X'="?" " ??",*7 W !!?3,"Enter 'N' to get Names",!?3," 'C' to get Codes",!?3," 'X' to print neither names or codes",! G ASK
|
|
D ^QAQDATE G:QAQQUIT EXIT
|
|
K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTDESC="Adverse findings report",ZTRTN="ENTSK^QAOSPAD0",ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
|
|
ENTSK ;
|
|
K ^TMP($J,"A") S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSPEER=+$O(^QA(741.2,"C",2,0)),QAOSEXCP=+$O(^QA(741.6,"B",3,0))
|
|
F QAOSDT=QAQNBEG-.0000001:0 S QAOSDT=$O(^QA(741,"C",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>QAQNEND) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDT,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
|
U IO D ^QAOSPAD1
|
|
EXIT ;
|
|
W ! D ^%ZISC
|
|
K %ZIS,ATTEND,DATE,DI,DH,DM,FIND,LOC,PAGE,PAT,POP,PROV,PT,QAOSCHOS,QAOSD0,QAOSDT,QAOSQUIT,QAOSZERO,SCRN,SERV,SRV,SSN,STATUS,TEAM,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,D,I,Y,Z,QAOSCLIN,QAOSEXCP,QAOSD1,QAOSPEER
|
|
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
LOOP1 ;
|
|
S QAOSZERO=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN")),STATUS=+$P(QAOSZERO,"^",11) Q:(STATUS=2)!(SCRN'>0)
|
|
S Y=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0)) Q:QAOSEXCP=+$P($G(^QA(741,QAOSD0,"REVR",Y,0)),"^",5)
|
|
K FIND S (FIND(12),FIND(13))=0
|
|
F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,QAOSD1)) Q:QAOSD1'>0 D
|
|
. S X=$G(^QA(741,QAOSD0,"REVR",QAOSD1,0)) Q:$P(X,"^",9)'>0
|
|
. S FIND=+$G(^QA(741.6,+$P(X,"^",5),0)) Q:(FIND'>0)!(FIND=11)
|
|
. S FIND(FIND)=1
|
|
. Q
|
|
S FIND=$S(FIND(12)&FIND(13):"2&3",FIND(12):"2",FIND(13):"3",1:"")
|
|
Q:FIND="" S FIND="LEVEL "_FIND
|
|
S PAT=$S($D(^DPT(+QAOSZERO,0))#2:^(0),1:+QAOSZERO),SSN=$P(PAT,"^",9),PAT=$P(PAT,"^"),SCRN=$S($D(^QA(741.1,SCRN,0))#2:+^(0),1:SCRN),DATE=$P(QAOSZERO,"^",3)
|
|
S SERV=$P(QAOSZERO,"^",6),SERV=$S(SERV'>0:"~UNKNOWN",$D(^DIC(49,SERV,0))#2:$P(^(0),"^"),1:"~UNKNOWN"),STATUS=$S(+STATUS=0:"OPEN",1:"CLOSED")
|
|
S (ATTEND,PROV,TEAM)="" G:QAOSCHOS="X" SETUTIL
|
|
S ATTEND=$P(QAOSZERO,"^",9),PROV=$P(QAOSZERO,"^",10),TEAM=$P(QAOSZERO,"^",8) G:QAOSCHOS="C" SETUTIL
|
|
S ATTEND=$S(ATTEND'>0:"",$D(^VA(200,ATTEND,0))#2:$P(^(0),"^"),1:ATTEND),PROV=$S(PROV'>0:"",$D(^VA(200,PROV,0))#2:$P(^(0),"^"),1:PROV),TEAM=$S(TEAM'>0:"",$D(^QA(741.93,TEAM,0))#2:$P(^(0),"^"),1:TEAM)
|
|
SETUTIL S ^TMP($J,"A",SERV,PAT,SCRN,DATE)=SSN_"^"_FIND_"^"_STATUS_"^"_ATTEND_"^"_PROV_"^"_TEAM_"^"_QAOSD0
|
|
Q
|