- 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
