source: FOIAVistA/trunk/r/MEDICINE-MC/MCARGS.m@ 1397

MCARGS ;WISC/TJK-SPECIAL CODE FOR PRINT TEMPLATES ;5/2/96  13:01
 ;;2.3;Medicine;;09/13/1996
IND ;PRINTS OUT SPECIAL FIELDS RELATED TO INDICATION FOR PROCEDURE
 I $D(^MCAR(699,MCARGDA,3)) S Z1=3,Z2=695.5,Z3="SYMPTOM: " D SPEC G EXIT:$D(MCOUT)
 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)
 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)
 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)
 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)
 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)
 G EXIT
WP Q:'$D(^MCAR(699,MCARGDA,Z1))  Q:$P(^(Z1),U,Z2)=""
 S X=$P(^MCAR(699,MCARGDA,Z1),U,Z2)
WP1 S X=Z3_": "_X,DIWL=3,DIWR=79 D ^DIWP,^DIWW
 D:$Y>(IOSL-3) X Q
COL ;PRINTS OUT DIET INFORMATION FOR COLONOSCOPY
 I '$D(^MCAR(699,MCARGDA,15)),'$D(^(14)) Q
 G PREP:'$D(^MCAR(699,MCARGDA,15)) S Z1=$P(^(15),U,1,3)
 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)
 S Z2=$P(Z1,U,2) W:Z2'="" !,?2,"Diet Comment: ",Z2 D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
 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)
PREP Q:'$D(^MCAR(699,MCARGDA,14))
 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:"")
 G EXIT
LAP ;PRINTS OUT PNEUMOPERITONEUM GAS INFO FOR LAP PROCEDURES
 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
 G EXIT
TECH ;PRINTS OUT SPECIAL CODE FOR TECHNIQUE FOR GI ENDOSCOPY
 Q:'$D(^MCAR(699,D0,30,D1,4))  S Z2=^(4)
 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)
 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)
 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
 D:$Y>(IOSL-3) X G EXIT:$D(MCOUT)
 S X=$P(Z2,U,6) I X'="" S Z3="SAVARY BOUGIE DIAMETER" D WP1 G EXIT:$D(MCOUT)
 S X=$P(Z2,U,7) I X'="" S Z3="HEATER PROBE DURATION" D WP1 G EXIT:$D(MCOUT)
 S X=$P(Z2,U,8) I X'="" S Z3="HEATER PROBE POWER" D WP1 G EXIT:$D(MCOUT)
EXIT K Z1,Z2,Z3 Q
 W !,?10,"Duration: ",$P(I,U,4),?50,"Frequency: ",$P(I,U,5) D:$Y>(IOSL-3) X Q
SPEC 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
 Q
SET 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:"")
 Q
X X ^UTILITY($J,1)
 Q
BOWPREP ;;BISCODYL;CASTER OIL;GOLYELY;MAGNESIUM CITRATE;NEOLOID;OTHER;PHOSPHASODA