source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARGS.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1MCARGS ;WISC/TJK-SPECIAL CODE FOR PRINT TEMPLATES ;5/2/96 13:01
2 ;;2.3;Medicine;;09/13/1996
3IND ;PRINTS OUT SPECIAL FIELDS RELATED TO INDICATION FOR PROCEDURE
4 I $D(^MCAR(699,MCARGDA,3)) S Z1=3,Z2=695.5,Z3="SYMPTOM: " D SPEC G EXIT:$D(MCOUT)
5 I $D(^MCAR(699,MCARGDA,10)) W ! F I=0:0 S I=$O(^MCAR(699,MCARGDA,10,I)) Q:I'?1N.N S J=^(I,0) W:$D(^MCAR(695.5,+J,0)) !,?2,"Type of Cough: ",$P(^(0),U,1),?50,"Duration: ",$P(J,U,2) D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
6 I $D(^MCAR(699,MCARGDA,11)) W ! F I=0:0 S I=$O(^MCAR(699,MCARGDA,11,I)) Q:I'?1N.N S J=^(I,0) W:$D(^MCAR(699.83,+J,0)) !,?2,"Location of Pneumonia: ",$P(^(0),U,1),?50,"Dates: ",$P(J,U,2) D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
7 F Z1=7,5,6,2 S Z2=$S(Z1=7:699.86,Z1=5:699.84,Z1=6:699.85,1:699.6),Z3=$S(Z1=7:"SURVEILLANCE: ",Z1=5:"DISEASE FOLLOWUP: ",Z1=6:"FOLLOWUP DEVICE/THERAPY: ",1:"INDICATED THERAPY: ") D SPEC G EXIT:$D(MCOUT)
8 S Z1=31,Z2=1,Z3="PROTOCOL" D WP G EXIT:$D(MCOUT) S Z2=2,Z3="EGD SIMPLE PRIMARY EXAM" D WP G EXIT:$D(MCOUT) S Z2=3,Z3="LAB OR XRAY" D WP G EXIT:$D(MCOUT)
9 S Z1=32,Z2=1,Z3="OCCULT BLOOD" D WP G EXIT:$D(MCOUT) S Z2=2,Z3="SPECIMEN COLLECTION" D WP G EXIT:$D(MCOUT)
10 G EXIT
11WP Q:'$D(^MCAR(699,MCARGDA,Z1)) Q:$P(^(Z1),U,Z2)=""
12 S X=$P(^MCAR(699,MCARGDA,Z1),U,Z2)
13WP1 S X=Z3_": "_X,DIWL=3,DIWR=79 D ^DIWP,^DIWW
14 D:$Y>(IOSL-3) X Q
15COL ;PRINTS OUT DIET INFORMATION FOR COLONOSCOPY
16 I '$D(^MCAR(699,MCARGDA,15)),'$D(^(14)) Q
17 G PREP:'$D(^MCAR(699,MCARGDA,15)) S Z1=$P(^(15),U,1,3)
18 S Z2=$P(Z1,U,1) W:Z2 !,?2,"Preparation Diet: ",$S(Z2=1:"NO CHANGE",Z2=2:"CLEAR LIQUIDS",Z2=3:"SUPPLEMENT",Z2=4:"OTHER",1:"") D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
19 S Z2=$P(Z1,U,2) W:Z2'="" !,?2,"Diet Comment: ",Z2 D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
20 S Z2=$P(Z1,U,3) W:Z2'="" !,?2,"Enemas: ",$S(Z2=1:"WATER",Z2=2:"PHOSPASODA",Z2=3:"OTHER",1:"") D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
21PREP Q:'$D(^MCAR(699,MCARGDA,14))
22 F I=0:0 S I=$O(^MCAR(699,MCARGDA,14,I)) Q:I'?1N.N S Z1=^(I,0),Z2=$P($T(BOWPREP),";",+Z1+2) W:Z2'="" !,?2,"Bowel Preparation: ",Z2,?50,$S($P(Z1,U,2)="PO":"ORAL",$P(Z1,U,2)="PR":"RECTAL",1:"")
23 G EXIT
24LAP ;PRINTS OUT PNEUMOPERITONEUM GAS INFO FOR LAP PROCEDURES
25 Q:'$D(^MCAR(699,MCARGDA,13)) F I=0:0 S I=$O(^MCAR(699,MCARGDA,13,I)) Q:I'?1N.N I $D(^(I,0)) S Z1=^(0) D SET W !," Pneumoperitoneum Gas: ",Z2,?50,"Pressure Control: ",Z3
26 G EXIT
27TECH ;PRINTS OUT SPECIAL CODE FOR TECHNIQUE FOR GI ENDOSCOPY
28 Q:'$D(^MCAR(699,D0,30,D1,4)) S Z2=^(4)
29 S Z1=$P(Z2,U,1) I Z1,$D(^MCAR(699.7,Z1,0)) S I=$P(^(0),U,1) W !,?2,"Stent Type: ",I,?50,"Stent Size: ",$P(Z2,U,2),!,?50,"Stent Length (mm):",$P(Z2,U,3) D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
30 S Z1=$P(Z2,U,4) I Z1,$D(^MCAR(699.7,Z1,0)) S I=$P(^(0),U,1) W !,?2,"Sphincterotome Used: ",I,?50,"Incision Size: ",$P(Z2,U,5) D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
31 F Z3=9,10 S Z1=$P(Z2,U,Z3) I Z1,$D(^MCAR(699.7,Z1,0)) S I=$P(^(0),U,1) W !,?2,$S(Z3=9:"GASTROTOMY",1:"JEJUNOSTOMY")_" TUBE: ",I
32 D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
33 S X=$P(Z2,U,6) I X'="" S Z3="SAVARY BOUGIE DIAMETER" D WP1 G EXIT:$D(MCOUT)
34 S X=$P(Z2,U,7) I X'="" S Z3="HEATER PROBE DURATION" D WP1 G EXIT:$D(MCOUT)
35 S X=$P(Z2,U,8) I X'="" S Z3="HEATER PROBE POWER" D WP1 G EXIT:$D(MCOUT)
36EXIT K Z1,Z2,Z3 Q
37 W !,?10,"Duration: ",$P(I,U,4),?50,"Frequency: ",$P(I,U,5) D:$Y>(IOSL-3) X Q
38SPEC I $D(^MCAR(699,MCARGDA,Z1)) S MC1="" F I=0:0 S I=$O(^MCAR(699,MCARGDA,Z1,I)) Q:I'?1N.N S J=^(I,0) I $D(^MCAR(Z2,+J,0)) W:$D(MC1) !,?2,Z3 W:'$D(MC1) "," S J=$P(^(0),U,1) W:($X+$L(J)>79) !,?2 D:($X<3)&($Y>(IOSL-3)) X W J K MC1
39 Q
40SET S Z2=$P(Z1,U,1),Z3=$P(Z1,U,2),Z2=$S(Z2="A":"AIR",Z2="C":"CO2",Z2="N":"NO2",Z2="O":"OTHER",1:""),Z3=$S(Z3="A":"AUTOMATIC",Z3="M":"MANUAL",1:"")
41 Q
42X X ^UTILITY($J,1)
43 Q
44BOWPREP ;;BISCODYL;CASTER OIL;GOLYELY;MAGNESIUM CITRATE;NEOLOID;OTHER;PHOSPHASODA
Note: See TracBrowser for help on using the repository browser.