- MCARGE ;WISC/TJK-GI ENTER/EDIT ;5/8/96 14:29
- ;;2.3;Medicine;;09/13/1996
- START ;EDIT ENDSCOPY
- K EXIT,MCDEMO,MCESFL S MCESFL=1 D PREEDT
- I '$D(MCFILE)!'$D(MCARGDA) D EXIT Q
- I '$D(^MCAR(MCFILE,MCARGDA,0)),$D(MCBACK) D BACKSS^MCESEDT K MCBACK
- K:'$D(^MCAR(MCFILE,MCARGDA,0)) MCESFL
- I $D(MCESFL),MCESON D:MCESFL=0 ESRC^MCESSCR(MCFILE,MCARGDA)
- D EXIT
- Q
- PREEDT ; Allow editing of demo and allergy
- S MCDEMO=1 D DPT Q:$D(EXIT)
- I MCARCODE="G"!(MCARCODE="P") F D DEMO Q:'$D(MCDEMO) D:$D(MCDEMO) EDITDEMO
- Q:$D(EXIT) D EDIT
- Q
- EDIT ;Lets edit Endoscopy
- K DR,DIC,DIE S (DIE,DIC)="^MCAR(699,",DA=MCARGDA,MCFILE=699
- G EDIT1:MCARGNAM="NON-ENDO",EDIT1:MCARCODE'="G" D SETVAR
- EDIT1 ; Lets edit Non-Endo
- D IN^MCEO I $D(DTOUT)!$D(DUOUT) S EXIT=1 Q
- S DR="["_MCEPROC_"]" D ^DIE
- I $D(DA) D ^MCARGD,OUT^MCEO
- Q
- EXIT ;Lets leave
- D EXIT^MCARE
- Q
- SETVAR ;Set Pulmonary variables
- S MCSTENT=$O(^MCAR(699.6,"B","INSERTION OF STENT",0)),MCSPHIN=$O(^MCAR(699.6,"B","SPHINCTEROTOMY",0))
- S MCBOUGIE=$O(^MCAR(699.6,"B","DILATION BY SAVARY BOUGIE",0)),MCGTUBE=$O(^MCAR(699.6,"B","GASTROSTOMY TUBE INSERTED",0)),MCJTUBE=$O(^MCAR(699.6,"B","JEJUNOSTOMY TUBE INSERTED",0))
- S MCHEATP=$O(^MCAR(699.6,"B","HEATER PROBE COAGULATION",0))
- Q
- CONSULT K DIC S MCARGNUM=$O(^MCAR(697.2,"B","CONSULT",0)),DIC("DR")=".01;.02;2////1;.05////"_MCARGNUM
- S DIC="^MCAR(699.5,",DLAYGO=699.5,DIC(0)="AEQLMZ",DIC("A")="ENTER DATE/TIME OF CONSULT: ",DIC("S")="I $P(^MCAR(699.5,+Y,0),U,3)" D ^DIC K DIC("S"),DIC("A"),DLAYGO I $D(MCDFLAG),Y<0 Q
- G EXIT:Y<0
- I '$P(Y(0),U,2)!'$P(Y(0),U,3) S DIK="^MCAR(699.5,",DA=+Y D ^DIK Q:$D(MCDFLAG) G EXIT
- S DFN=$P(Y(0),U,2),DIE=DIC,(MCARGDA,DA)=+Y Q:$D(MCDFLAG)
- S MCFILE=699.5 D ORDER^MCARGEO G EXIT:$D(DTOUT)!$D(DUOUT) S DR=$S($G(MCBS)=1:"[MCCONSULTBR]",1:"[MCCONSULT]") D ^DIE,ORDER1^MCARGEO,QTASK^MCPARAM G EXIT
- DPT ;ALSO CALLED FROM MCARGES
- S MCESFL=0 D MCEPROC^MCARE S MCARGNUM=MCARP
- D DATE^MCAREH
- S DIC="^MCAR(699,",DIC("A")="Enter Date/Time of Procedure: ",DIC(0)="AEQLMZ"
- S DIC("S")="S MCARCK=$P(^MCAR(699,+Y,0),U,12) I MCARCK'="""",$D(^MCAR(697.2,""D"",MCARCODE,MCARCK))",(DLAYGO,MCFILE)=699
- I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
- D ^DIC K DIC,DLAYGO,MCBACK S MCARDA=Y
- I Y<0 S EXIT=0 Q
- S DFN=$P(Y(0),U,2),MCARGDA=+Y,MCARGNUM=$P(Y(0),U,12),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
- I MCESON,("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA)) D ESRC^MCESSCR(MCFILE,MCARGDA) I '$D(MCBACK) S X=U,MCESFL=1,EXIT=1 Q ;RMP CHANGED () EXPRESSION FROM >2
- I $D(MCBACK) D BACK S X=U Q
- I $D(DTOUT),('$P(Y(0),U,2)!'$P(Y(0),U,12)) S DIK="^MCAR(699,",DA=+Y D ^DIK S EXIT=1 Q
- Q
- DEMO ;Lets display the demo information ask if they want to edit
- ; -------------------
- ; SSN = External Format of the patients SSN
- ; -------------------
- D DEM^VADPT S SSN=$P(VADM(2),U,2) D HIST Q
- HIST ;Lets look at the history
- W !!,?26,"PERSONAL HISTORY INFORMATION",!,?5,VADM(1),?50,"SSN: ",SSN,!
- S DIC="^MCAR(690,",DA=DFN G HIST1:MCARCODE="P"
- S DR="GI" D EN^DIQ K DIC,DR G HIST2
- HIST1 ;Lets look at some more history
- K ^UTILITY("DIQ1",$J) S DIC="^MCAR(690,",DA=DFN,DR="3:6" D EN^DIQ1 G HIST2:'$D(^UTILITY("DIQ1",$J))
- W !,?2,"History of Bleeding Disorder: ",^UTILITY("DIQ1",$J,690,DA,3),?40,"Valvular Heart Disease: ",^(4),!,?2,"Glaucoma: ",^(5),!,?2,"History Comments: ",^(6) K ^UTILITY("DIQ1",$J) W !
- HIST2 ;Lets display allergy and ask the question
- D ^MCARGEA ; display allergy information
- S DIR(0)="Y",DIR("A")="Do you wish to edit the Personal History Information"
- S DIR("?")="Answer 'YES' or 'NO'",DIR("B")="NO" D ^DIR K DIR
- I $D(DUOUT)!$D(DIROUT) S EXIT=1 K MCDEMO Q
- K:Y=0 MCDEMO Q
- EDITDEMO ;lets edit the demo and allergy using the line editor
- S (DIE,DIC)="^MCAR(690,",DA=DFN,DR="[MCARGIED]" D ^DIE
- I $D(^DIC(120.8)) N VADM D EN2^GMRAPEM0 Q
- G HIST
- ;
- HELP ;DISPLAY CHOOSABLE ANATOMY LOCATIONS-CALLED BY FINDINGS,ATRIAL STUDY,VENTRICULAR STUDY FILES
- S (DZ,MCDONE)="" W !!,"The valid Anatomy locations are: ",!
- F I=0:0 S I=$O(^MCAR(697,"C",MCARGNUM,I)) Q:'I W:$X>50 ! W $E($P(^MCAR(697,I,0),U)_" ",1,40) I $D(DJDN),$Y>20,$X>50 W ! R "'^' TO STOP: ",%Y:DTIME X:%Y'?1"^" DJCP Q:%Y?1"^"
- R:$D(DJDN) !,"* END * Press return to continue: ",%Y:DTIME Q
- DPTNON ;
- S DIC="^MCAR(699,",DIC("A")="Enter Date/Time of Non-Endoscopic Procedure: ",DIC(0)="AEQLMZ"
- S DIC("S")="I $P($G(^MCAR(697.2,+$P(^MCAR(699,+Y,0),U,12),0)),U)=""NON-ENDO"""_MCTEST,DLAYGO=699
- S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
- S DIC("DR")=".02;1///NON-ENDO"
- D ^DIC
- K DIC,DLAYGO
- I $D(MCDFLAG),Y<0 S X=U Q
- G EXIT:Y<0
- I $D(DTOUT),('$P(Y(0),U,2)!'$P(Y(0),U,12)) S DIK="^MCAR(699,",DA=+Y D ^DIK Q:$D(MCDFLG) G EXIT
- S DFN=$P(Y(0),U,2),MCARGDA=+Y,MCARGNUM=$P(Y(0),U,12),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
- ; -------------------
- ; SSN = External Format of the patients SSN
- ; -------------------
- D DEM^VADPT S SSN=$P(VADM(2),U,2)
- G HIST
- BACK ;
- S Y=MCY,Y(0)=MCY(0),Y(0,0)=MCY(0,0),MCARGDA=+Y K EXIT,MCY,DTOUT,DIROUT,DUOUT,MCDFLAG
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARGE 5045 printed Jan 18, 2025@03:14:06 Page 2
- MCARGE ;WISC/TJK-GI ENTER/EDIT ;5/8/96 14:29
- +1 ;;2.3;Medicine;;09/13/1996
- START ;EDIT ENDSCOPY
- +1 KILL EXIT,MCDEMO,MCESFL
- SET MCESFL=1
- DO PREEDT
- +2 IF '$DATA(MCFILE)!'$DATA(MCARGDA)
- DO EXIT
- QUIT
- +3 IF '$DATA(^MCAR(MCFILE,MCARGDA,0))
- IF $DATA(MCBACK)
- DO BACKSS^MCESEDT
- KILL MCBACK
- +4 if '$DATA(^MCAR(MCFILE,MCARGDA,0))
- KILL MCESFL
- +5 IF $DATA(MCESFL)
- IF MCESON
- if MCESFL=0
- DO ESRC^MCESSCR(MCFILE,MCARGDA)
- +6 DO EXIT
- +7 QUIT
- PREEDT ; Allow editing of demo and allergy
- +1 SET MCDEMO=1
- DO DPT
- if $DATA(EXIT)
- QUIT
- +2 IF MCARCODE="G"!(MCARCODE="P")
- FOR
- DO DEMO
- if '$DATA(MCDEMO)
- QUIT
- if $DATA(MCDEMO)
- DO EDITDEMO
- +3 if $DATA(EXIT)
- QUIT
- DO EDIT
- +4 QUIT
- EDIT ;Lets edit Endoscopy
- +1 KILL DR,DIC,DIE
- SET (DIE,DIC)="^MCAR(699,"
- SET DA=MCARGDA
- SET MCFILE=699
- +2 if MCARGNAM="NON-ENDO"
- GOTO EDIT1
- if MCARCODE'="G"
- GOTO EDIT1
- DO SETVAR
- EDIT1 ; Lets edit Non-Endo
- +1 DO IN^MCEO
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET EXIT=1
- QUIT
- +2 SET DR="["_MCEPROC_"]"
- DO ^DIE
- +3 IF $DATA(DA)
- DO ^MCARGD
- DO OUT^MCEO
- +4 QUIT
- EXIT ;Lets leave
- +1 DO EXIT^MCARE
- +2 QUIT
- SETVAR ;Set Pulmonary variables
- +1 SET MCSTENT=$ORDER(^MCAR(699.6,"B","INSERTION OF STENT",0))
- SET MCSPHIN=$ORDER(^MCAR(699.6,"B","SPHINCTEROTOMY",0))
- +2 SET MCBOUGIE=$ORDER(^MCAR(699.6,"B","DILATION BY SAVARY BOUGIE",0))
- SET MCGTUBE=$ORDER(^MCAR(699.6,"B","GASTROSTOMY TUBE INSERTED",0))
- SET MCJTUBE=$ORDER(^MCAR(699.6,"B","JEJUNOSTOMY TUBE INSERTED",0))
- +3 SET MCHEATP=$ORDER(^MCAR(699.6,"B","HEATER PROBE COAGULATION",0))
- +4 QUIT
- CONSULT KILL DIC
- SET MCARGNUM=$ORDER(^MCAR(697.2,"B","CONSULT",0))
- SET DIC("DR")=".01;.02;2////1;.05////"_MCARGNUM
- +1 SET DIC="^MCAR(699.5,"
- SET DLAYGO=699.5
- SET DIC(0)="AEQLMZ"
- SET DIC("A")="ENTER DATE/TIME OF CONSULT: "
- SET DIC("S")="I $P(^MCAR(699.5,+Y,0),U,3)"
- DO ^DIC
- KILL DIC("S"),DIC("A"),DLAYGO
- IF $DATA(MCDFLAG)
- IF Y<0
- QUIT
- +2 if Y<0
- GOTO EXIT
- +3 IF '$PIECE(Y(0),U,2)!'$PIECE(Y(0),U,3)
- SET DIK="^MCAR(699.5,"
- SET DA=+Y
- DO ^DIK
- if $DATA(MCDFLAG)
- QUIT
- GOTO EXIT
- +4 SET DFN=$PIECE(Y(0),U,2)
- SET DIE=DIC
- SET (MCARGDA,DA)=+Y
- if $DATA(MCDFLAG)
- QUIT
- +5 SET MCFILE=699.5
- DO ORDER^MCARGEO
- if $DATA(DTOUT)!$DATA(DUOUT)
- GOTO EXIT
- SET DR=$SELECT($GET(MCBS)=1:"[MCCONSULTBR]",1:"[MCCONSULT]")
- DO ^DIE
- DO ORDER1^MCARGEO
- DO QTASK^MCPARAM
- GOTO EXIT
- DPT ;ALSO CALLED FROM MCARGES
- +1 SET MCESFL=0
- DO MCEPROC^MCARE
- SET MCARGNUM=MCARP
- +2 DO DATE^MCAREH
- +3 SET DIC="^MCAR(699,"
- SET DIC("A")="Enter Date/Time of Procedure: "
- SET DIC(0)="AEQLMZ"
- +4 SET DIC("S")="S MCARCK=$P(^MCAR(699,+Y,0),U,12) I MCARCK'="""",$D(^MCAR(697.2,""D"",MCARCODE,MCARCK))"
- SET (DLAYGO,MCFILE)=699
- +5 IF MCESON
- SET DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
- +6 DO ^DIC
- KILL DIC,DLAYGO,MCBACK
- SET MCARDA=Y
- +7 IF Y<0
- SET EXIT=0
- QUIT
- +8 SET DFN=$PIECE(Y(0),U,2)
- SET MCARGDA=+Y
- SET MCARGNUM=$PIECE(Y(0),U,12)
- SET MCARGNAM=$PIECE(^MCAR(697.2,MCARGNUM,0),U)
- +9 ;RMP CHANGED () EXPRESSION FROM >2
- IF MCESON
- IF ("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA))
- DO ESRC^MCESSCR(MCFILE,MCARGDA)
- IF '$DATA(MCBACK)
- SET X=U
- SET MCESFL=1
- SET EXIT=1
- QUIT
- +10 IF $DATA(MCBACK)
- DO BACK
- SET X=U
- QUIT
- +11 IF $DATA(DTOUT)
- IF ('$PIECE(Y(0),U,2)!'$PIECE(Y(0),U,12))
- SET DIK="^MCAR(699,"
- SET DA=+Y
- DO ^DIK
- SET EXIT=1
- QUIT
- +12 QUIT
- DEMO ;Lets display the demo information ask if they want to edit
- +1 ; -------------------
- +2 ; SSN = External Format of the patients SSN
- +3 ; -------------------
- +4 DO DEM^VADPT
- SET SSN=$PIECE(VADM(2),U,2)
- DO HIST
- QUIT
- HIST ;Lets look at the history
- +1 WRITE !!,?26,"PERSONAL HISTORY INFORMATION",!,?5,VADM(1),?50,"SSN: ",SSN,!
- +2 SET DIC="^MCAR(690,"
- SET DA=DFN
- if MCARCODE="P"
- GOTO HIST1
- +3 SET DR="GI"
- DO EN^DIQ
- KILL DIC,DR
- GOTO HIST2
- HIST1 ;Lets look at some more history
- +1 KILL ^UTILITY("DIQ1",$JOB)
- SET DIC="^MCAR(690,"
- SET DA=DFN
- SET DR="3:6"
- DO EN^DIQ1
- if '$DATA(^UTILITY("DIQ1",$JOB))
- GOTO HIST2
- +2 WRITE !,?2,"History of Bleeding Disorder: ",^UTILITY("DIQ1",$JOB,690,DA,3),?40,"Valvular Heart Disease: ",^(4),!,?2,"Glaucoma: ",^(5),!,?2,"History Comments: ",^(6)
- KILL ^UTILITY("DIQ1",$JOB)
- WRITE !
- HIST2 ;Lets display allergy and ask the question
- +1 ; display allergy information
- DO ^MCARGEA
- +2 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to edit the Personal History Information"
- +3 SET DIR("?")="Answer 'YES' or 'NO'"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DUOUT)!$DATA(DIROUT)
- SET EXIT=1
- KILL MCDEMO
- QUIT
- +5 if Y=0
- KILL MCDEMO
- QUIT
- EDITDEMO ;lets edit the demo and allergy using the line editor
- +1 SET (DIE,DIC)="^MCAR(690,"
- SET DA=DFN
- SET DR="[MCARGIED]"
- DO ^DIE
- +2 IF $DATA(^DIC(120.8))
- NEW VADM
- DO EN2^GMRAPEM0
- QUIT
- +3 GOTO HIST
- +4 ;
- HELP ;DISPLAY CHOOSABLE ANATOMY LOCATIONS-CALLED BY FINDINGS,ATRIAL STUDY,VENTRICULAR STUDY FILES
- +1 SET (DZ,MCDONE)=""
- WRITE !!,"The valid Anatomy locations are: ",!
- +2 FOR I=0:0
- SET I=$ORDER(^MCAR(697,"C",MCARGNUM,I))
- if 'I
- QUIT
- if $X>50
- WRITE !
- WRITE $EXTRACT($PIECE(^MCAR(697,I,0),U)_" ",1,40)
- IF $DATA(DJDN)
- IF $Y>20
- IF $X>50
- WRITE !
- READ "'^' TO STOP: ",%Y:DTIME
- if %Y'?1"^"
- XECUTE DJCP
- if %Y?1"^"
- QUIT
- +3 if $DATA(DJDN)
- READ !,"* END * Press return to continue: ",%Y:DTIME
- QUIT
- DPTNON ;
- Press return to continue: +1 SET DIC="^MCAR(699,"
- SET DIC("A")="Enter Date/Time of Non-Endoscopic Procedure: "
- SET DIC(0)="AEQLMZ"
- +2 SET DIC("S")="I $P($G(^MCAR(697.2,+$P(^MCAR(699,+Y,0),U,12),0)),U)=""NON-ENDO"""_MCTEST
- SET DLAYGO=699
- +3 SET DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
- +4 SET DIC("DR")=".02;1///NON-ENDO"
- +5 DO ^DIC
- +6 KILL DIC,DLAYGO
- +7 IF $DATA(MCDFLAG)
- IF Y<0
- SET X=U
- QUIT
- +8 if Y<0
- GOTO EXIT
- +9 IF $DATA(DTOUT)
- IF ('$PIECE(Y(0),U,2)!'$PIECE(Y(0),U,12))
- SET DIK="^MCAR(699,"
- SET DA=+Y
- DO ^DIK
- if $DATA(MCDFLG)
- QUIT
- GOTO EXIT
- +10 SET DFN=$PIECE(Y(0),U,2)
- SET MCARGDA=+Y
- SET MCARGNUM=$PIECE(Y(0),U,12)
- SET MCARGNAM=$PIECE(^MCAR(697.2,MCARGNUM,0),U)
- +11 ; -------------------
- +12 ; SSN = External Format of the patients SSN
- +13 ; -------------------
- +14 DO DEM^VADPT
- SET SSN=$PIECE(VADM(2),U,2)
- +15 GOTO HIST
- BACK ;
- +1 SET Y=MCY
- SET Y(0)=MCY(0)
- SET Y(0,0)=MCY(0,0)
- SET MCARGDA=+Y
- KILL EXIT,MCY,DTOUT,DIROUT,DUOUT,MCDFLAG
- +2 QUIT