source: FOIAVistA/trunk/r/MEDICINE-MC/MCARPS.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1MCARPS ;WISC/TJK,RCH-PROCEDURE SUMMARY REPORTS ;6/18/97 10:53
2 ;;2.3;Medicine;**8**;09/13/1996
3CHOOZ K S5 R !,"PRINT BY DATE OR PROCEDURE (D/P): D//",WH:DTIME
4 S WH=$E(WH,1) G BEG:"DP"[WH I WH'?1"^".E W:WH'?1"?".E *7," ??" D HELP G CHOOZ
5 K WH,X,Y Q
6BEG ;SEARCH FOR SELECTED PATIENT IN CARDIOLOGY FILE
7 I WH="P" D PROC I $D(S5),S5=U G CHOOZ
8 S DIC="^MCAR(690,",DIC(0)="AEQM"
9 D ^DIC I Y<0 K WH,DIC,Y Q
10 ; ------------------------
11 ; SSN = Enternal Format of the patients SSN with the first letter
12 ; of the last name tacked on the end
13 ; ------------------------
14 S DFN=+Y D DEM^VADPT S MCARNM=VADM(1),SSN=VA("PID")
15 D INP^VADPT S WARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT") D KVAR^VADPT
16LOC ;LOCATE PROCEDURES FROM "AC" X-REF
17 I '$D(^MCAR(690,"AC",DFN)) W !!,"NO PROCEDURES FOR THIS PATIENT" G BEG
18 I $D(S5),'$D(@(U_S5_",""C"","_DFN_")")) W !!,"NO ",$P(@(U_S5_",0)"),U,1)," PROCEDURES FOR THIS PATIENT" G BEG
19 D ^MCARPS1
20PR K IO("Q") S %ZIS="QM" D ^%ZIS K %ZIS G EXIT:POP
21 I $D(IO("Q")) K IO("Q") S ZTRTN="PR0^MCARPS",ZTDESC="PROCEDURE SUMMARY"
22 I S ZTSAVE("^TMP(""MCAR"",$J,")="",(ZTSAVE("DFN"),ZTSAVE("WH"),ZTSAVE("MC*"),ZTSAVE("SSN"),ZTSAVE("WARD"))="" D ^%ZTLOAD K ZTSK W !!,*7,"Report Queued" G FIN
23 U IO
24PR0 D TOP S I="",L=0
25PR1 S I=$O(^TMP("MCAR",$J,I)) G PR1:I="OT" I I="" G EXP:IOST'?1"P-".E,FIN
26 S J=""
27PR2 S J=$O(^TMP("MCAR",$J,I,J)) G PR1:J=""
28 S PR=^(J),MCARDT=$S(WH="P":$P(J,U),1:I),MCARPROC=$S(WH="P":I,1:$P(J,U)) ;MC*2.3*8
29 S MCARPROC=$O(^MCAR(697.2,"B",MCARPROC,0)),MCARPROC=$P(^MCAR(697.2,MCARPROC,0),U,8)
30 I $P(PR,U,12)'="" S MCARPROC=$P(PR,U,12) ;MC*2.3*8
31 S DA=$P(PR,U,2),K=$P(PR,U),M=$P(PR,U,10)
32 S K=$S(K="N"!(K="L"):"NORMAL",K="A":"ABNORMAL",K="B":"BORDERLINE",K="T":"TECHNICALLY UNSATISFACTORY",K="ND":"NON-DIAGNOSTIC",K="MI":"MILDLY ABNORMAL",K="MO":"MODERATELY ABNORMAL",K="S":"SEVERELY ABNORMAL",1:"")
33 ;S Y=9999999.9999-MCARDT X ^DD("DD") S L=L+1 W !,$J(L,2),?4,MCARPROC,?36,Y,?56,$E(K,1,22) W !,?1,M S ^TMP("MCAR",$J,"OT",L)=MCARPROC_U_DA_U_$P(PR,U,3,5)_U_J S $P(^(L),U,6)=Y,$P(^(L),U,7)=K,$P(^(L),U,10)=M,$P(^(L),U,11)=J
34 S Y=9999999.9999-MCARDT X ^DD("DD") S L=L+1 W !,$J(L,2),?4,MCARPROC,?36,Y,?56,$E(K,1,22) W !,?1,M S ^TMP("MCAR",$J,"OT",L)=MCARPROC_U_DA_U_$P(PR,U,3,5)_U_J S $P(^(L),U,6)=Y,$P(^(L),U,7)=K,$P(^(L),U,10)=M,$P(^(L),U,11)=$S(WH="P":I_U_$P(J,U,2),1:J)
35 S LN=LN+2 I LN'<(IOSL-2) G EXP:IOST'?1"P-".E D TOP
36 G PR2
37TOP W @IOF,!,"NAME: ",MCARNM,?35,"SSN: ",SSN,?55,"WARD: ",$E(WARD,1,19)
38 ;W !!,"PROCEDURE",?36,"DATE",?56,"RESULTS",! F M=1:1:79 W "-"
39 W !!,"(SUBSPECIALTY)/PROCEDURE",?36,"DATE",?56,"RESULTS" S M="",$P(M,"-",79)="-" W !,M
40 S LN=6 Q
41EXP G FIN:LN=6 W !!,*7,"FOR PROCEDURE EXPANSION (1-",L,") OR <RETURN> TO CONTINUE DISPLAY//" R R:DTIME G EXIT:R=U,EXIT:'$T
42 I R'="",$D(^TMP("MCAR",$J,"OT",R)) G EXP1
43 G FIN:I="" D TOP G PR2
44EXP1 W @IOF,!! S OT=^TMP("MCAR",$J,"OT",R),(DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11) D MCPPROC^MCARP
45 S MCARGRTN=$P(OT,U,5)
46 K DXS D NEW,REDISP G EXP
47FIN W:IOST'?1"P-".E !!,"END OF REPORT" W:IOST?1"P-".E @IOF D ^%ZISC
48EXIT S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
49 K LN,PR,OT,DA,MCARPPS,I,J,R,L,S1,S2,S4,S5,S6,DFN,LL,LL1,MCARGRTN,POP,IO("Q")
50 K ^TMP("MCAR",$J),K,N,MCARDT,WARD,MCARNM,MCARPROC,M,SSN
51 ;The kill statement on next line will reset the TMP global for Imaging
52 K ^TMP("MAG","ROW"),^("COL")
53 Q
54NEW N DFN,SSN,I,J,L D @MCARPPS Q
55REDISP S MCL=$S(L#8:L-(L#8),1:L-8) D TOP
56 F MCRED=MCL+1:1:MCL+8 Q:'$D(^TMP("MCAR",$J,"OT",MCRED)) S MCRED1=^(MCRED) W !,$J(MCRED,2),?4,$P(MCRED1,U),?36,$P(MCRED1,U,6),?56,$E($P(MCRED1,U,7),1,22),!,?1,$P(MCRED1,U,10) S LN=LN+2
57 K MCL,MCRED,MCRED1 Q
58PROC K PE,S5 R !,"Select Procedure: ALL// ",S5:DTIME
59 Q:S5=U I S5="ALL"!(S5="") K S5 Q
60 S DIC(0)="ZQE",DIC=697.2,X=S5 D ^DIC
61 G PROC:Y<0 S S5=$P(Y(0),U,2),PE=$P(Y(0),U,1) Q
62HELP W !,"You may sort this report by date or procedure.",!,"If you choose 'D' (date) all medical procedures will be displayed starting",!,"with the most recent procedure."
63 W !,"If you choose 'P' (procedure), you may specify in the next prompt either a",!,"specific procedure or 'ALL' procedures, alphabetically arranged with the most",!,"recent of that type of procedure displayed first." Q
Note: See TracBrowser for help on using the repository browser.