source: FOIAVistA/tag/r/MEDICINE-MC/MCARGE.m@ 628

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