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
MCARGS ;WISC/TJK-SPECIAL CODE FOR PRINT TEMPLATES ;5/2/96 13:01
+1 ;;2.3;Medicine;;09/13/1996
IND ;PRINTS OUT SPECIAL FIELDS RELATED TO INDICATION FOR PROCEDURE
+1 IF $DATA(^MCAR(699,MCARGDA,3))
SET Z1=3
SET Z2=695.5
SET Z3="SYMPTOM: "
DO SPEC
IF $DATA(MCOUT)
GOTO EXIT
+2 IF $DATA(^MCAR(699,MCARGDA,10))
WRITE !
FOR I=0:0
SET I=$ORDER(^MCAR(699,MCARGDA,10,I))
IF I'?1N.N
QUIT
SET J=^(I,0)
IF $DATA(^MCAR(695.5,+J,0))
WRITE !,?2,"Type of Cough: ",$PIECE(^(0),U,1),?50,"Duration: ",$PIECE(J,U,2)
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+3 IF $DATA(^MCAR(699,MCARGDA,11))
WRITE !
FOR I=0:0
SET I=$ORDER(^MCAR(699,MCARGDA,11,I))
IF I'?1N.N
QUIT
SET J=^(I,0)
IF $DATA(^MCAR(699.83,+J,0))
WRITE !,?2,"Location of Pneumonia: ",$PIECE(^(0),U,1),?50,"Dates: ",$PIECE(J,U,2)
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+4 FOR Z1=7,5,6,2
SET Z2=$SELECT(Z1=7:699.86,Z1=5:699.84,Z1=6:699.85,1:699.6)
SET Z3=$SELECT(Z1=7:"SURVEILLANCE: ",Z1=5:"DISEASE FOLLOWUP: ",Z1=6:"FOLLOWUP DEVICE/THERAPY: ",1:"INDICATED THERAPY: ")
DO SPEC
IF $DATA(MCOUT)
GOTO EXIT
+5 SET Z1=31
SET Z2=1
SET Z3="PROTOCOL"
DO WP
IF $DATA(MCOUT)
GOTO EXIT
SET Z2=2
SET Z3="EGD SIMPLE PRIMARY EXAM"
DO WP
IF $DATA(MCOUT)
GOTO EXIT
SET Z2=3
SET Z3="LAB OR XRAY"
DO WP
IF $DATA(MCOUT)
GOTO EXIT
+6 SET Z1=32
SET Z2=1
SET Z3="OCCULT BLOOD"
DO WP
IF $DATA(MCOUT)
GOTO EXIT
SET Z2=2
SET Z3="SPECIMEN COLLECTION"
DO WP
IF $DATA(MCOUT)
GOTO EXIT
+7 GOTO EXIT
WP IF '$DATA(^MCAR(699,MCARGDA,Z1))
QUIT
IF $PIECE(^(Z1),U,Z2)=""
QUIT
+1 SET X=$PIECE(^MCAR(699,MCARGDA,Z1),U,Z2)
WP1 SET X=Z3_": "_X
SET DIWL=3
SET DIWR=79
DO ^DIWP
DO ^DIWW
+1 IF $Y>(IOSL-3)
DO X
QUIT
COL ;PRINTS OUT DIET INFORMATION FOR COLONOSCOPY
+1 IF '$DATA(^MCAR(699,MCARGDA,15))
IF '$DATA(^(14))
QUIT
+2 IF '$DATA(^MCAR(699,MCARGDA,15))
GOTO PREP
SET Z1=$PIECE(^(15),U,1,3)
+3 SET Z2=$PIECE(Z1,U,1)
IF Z2
WRITE !,?2,"Preparation Diet: ",$SELECT(Z2=1:"NO CHANGE",Z2=2:"CLEAR LIQUIDS",Z2=3:"SUPPLEMENT",Z2=4:"OTHER",1:"")
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+4 SET Z2=$PIECE(Z1,U,2)
IF Z2'=""
WRITE !,?2,"Diet Comment: ",Z2
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+5 SET Z2=$PIECE(Z1,U,3)
IF Z2'=""
WRITE !,?2,"Enemas: ",$SELECT(Z2=1:"WATER",Z2=2:"PHOSPASODA",Z2=3:"OTHER",1:"")
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
PREP IF '$DATA(^MCAR(699,MCARGDA,14))
QUIT
+1 FOR I=0:0
SET I=$ORDER(^MCAR(699,MCARGDA,14,I))
IF I'?1N.N
QUIT
SET Z1=^(I,0)
SET Z2=$PIECE($TEXT(BOWPREP),";",+Z1+2)
IF Z2'=""
WRITE !,?2,"Bowel Preparation: ",Z2,?50,$SELECT($PIECE(Z1,U,2)="PO":"ORAL",$PIECE(Z1,U,2)="PR":"RECTAL",1:"")
+2 GOTO EXIT
LAP ;PRINTS OUT PNEUMOPERITONEUM GAS INFO FOR LAP PROCEDURES
+1 IF '$DATA(^MCAR(699,MCARGDA,13))
QUIT
FOR I=0:0
SET I=$ORDER(^MCAR(699,MCARGDA,13,I))
IF I'?1N.N
QUIT
IF $DATA(^(I,0))
SET Z1=^(0)
DO SET
WRITE !," Pneumoperitoneum Gas: ",Z2,?50,"Pressure Control: ",Z3
+2 GOTO EXIT
TECH ;PRINTS OUT SPECIAL CODE FOR TECHNIQUE FOR GI ENDOSCOPY
+1 IF '$DATA(^MCAR(699,D0,30,D1,4))
QUIT
SET Z2=^(4)
+2 SET Z1=$PIECE(Z2,U,1)
IF Z1
IF $DATA(^MCAR(699.7,Z1,0))
SET I=$PIECE(^(0),U,1)
WRITE !,?2,"Stent Type: ",I,?50,"Stent Size: ",$PIECE(Z2,U,2),!,?50,"Stent Length (mm):",$PIECE(Z2,U,3)
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+3 SET Z1=$PIECE(Z2,U,4)
IF Z1
IF $DATA(^MCAR(699.7,Z1,0))
SET I=$PIECE(^(0),U,1)
WRITE !,?2,"Sphincterotome Used: ",I,?50,"Incision Size: ",$PIECE(Z2,U,5)
IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+4 FOR Z3=9,10
SET Z1=$PIECE(Z2,U,Z3)
IF Z1
IF $DATA(^MCAR(699.7,Z1,0))
SET I=$PIECE(^(0),U,1)
WRITE !,?2,$SELECT(Z3=9:"GASTROTOMY",1:"JEJUNOSTOMY")_" TUBE: ",I
+5 IF $Y>(IOSL-3)
DO X
IF $DATA(MCOUT)
GOTO EXIT
+6 SET X=$PIECE(Z2,U,6)
IF X'=""
SET Z3="SAVARY BOUGIE DIAMETER"
DO WP1
IF $DATA(MCOUT)
GOTO EXIT
+7 SET X=$PIECE(Z2,U,7)
IF X'=""
SET Z3="HEATER PROBE DURATION"
DO WP1
IF $DATA(MCOUT)
GOTO EXIT
+8 SET X=$PIECE(Z2,U,8)
IF X'=""
SET Z3="HEATER PROBE POWER"
DO WP1
IF $DATA(MCOUT)
GOTO EXIT
EXIT KILL Z1,Z2,Z3
QUIT
+1 WRITE !,?10,"Duration: ",$PIECE(I,U,4),?50,"Frequency: ",$PIECE(I,U,5)
IF $Y>(IOSL-3)
DO X
QUIT
SPEC IF $DATA(^MCAR(699,MCARGDA,Z1))
SET MC1=""
FOR I=0:0
SET I=$ORDER(^MCAR(699,MCARGDA,Z1,I))
IF I'?1N.N
QUIT
SET J=^(I,0)
IF $DATA(^MCAR(Z2,+J,0))
IF $DATA(MC1)
WRITE !,?2,Z3
IF '$DATA(MC1)
WRITE ","
SET J=$PIECE(^(0),U,1)
IF ($X+$LENGTH(J)>79)
WRITE !,?2
IF ($X<3)&($Y>(IOSL-3))
DO X
WRITE J
KILL MC1
+1 QUIT
SET SET Z2=$PIECE(Z1,U,1)
SET Z3=$PIECE(Z1,U,2)
SET Z2=$SELECT(Z2="A":"AIR",Z2="C":"CO2",Z2="N":"NO2",Z2="O":"OTHER",1:"")
SET Z3=$SELECT(Z3="A":"AUTOMATIC",Z3="M":"MANUAL",1:"")
+1 QUIT
X XECUTE ^UTILITY($JOB,1)
+1 QUIT
BOWPREP ;;BISCODYL;CASTER OIL;GOLYELY;MAGNESIUM CITRATE;NEOLOID;OTHER;PHOSPHASODA
