MCARP1 ;WISC/TJK-PRINT ROUTINES TWO ;5/3/96  08:18
 ;;2.3;Medicine;**14,15,16**;09/13/1996
EXIT ;
 I IOST'?1"P-".E,'$D(MCOUT),$G(Y)'<0 R !!,"* END * Press return to continue: ",X:DTIME
 K ^UTILITY($J),IO("Q"),MCARGDA,MCARGDT,SSN,MCOUT,VA,DICMX,V
 K MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE
 K DIOEND,DIOBEG,DI,DIC,DJ,BY,A,DICSS,MCARGDT2,MCARPPS
 K DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
 K DL,DV,DE,DA,DK,Y,R,RH,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L,%T,D2
 K MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
 K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCARPS,MCSUP
 K MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCSTAT
 K MCARCODE,MCARDE,MCARGNAM,MCARGNUM,MCARGRTN,MCARP,MCARZ,MCBS
 K MCESS,MCESSEC,MCOUNT,MCPATFLD,MCPRO,MCSUP
 K ZTQUEUED,ZTREQ,FULL,MCPROP
 D ^%ZISC
 Q
INIT(MCARZ,MCARGDT,MCFILE) ;
 S PG=0
 I '$D(MCARGDT2) S X=MCARGDT D DTIME^MCARP S MCARGDT2=X
 D NOW^%DTC S X=% D DTIME^MCARP S MCARDTM=X
 ; ------------------------
 ; SSN = Enternal Format of the patients SSN with the first letter
 ; of the last name tacked on the end
 ; ------------------------
 D DEM^VADPT S MCARGNM=VADM(1),SSN=VA("PID"),X=$P(VADM(3),"^",2),MCARDOB=$S(X'="":X,1:"")
 I MCFILE=699,($G(MCARGNUM)'="") S MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
 D KVAR^VADPT
 D INP^VADPT S MCARWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MCARRB=VAIN(5) D KVAR^VADPT
 S MCARHDR=" CONFIDENTIAL "_MCARZ,MCAR="",$P(MCAR,"*",(77-$L(MCARHDR))\2)="*",MCARHDR=MCAR_" "_MCARHDR_" "_MCAR
 Q
MCPPROC ; Get require variables
 N OTEMP,TEMP,OPTION
 ;MCabPROC  <=== name of an option, screen or line edit.
 ; a = (B =>  Brief),  (F => Full)
 ; b = (S =>  Screen Edit), (L =>  Line Edit), (P =>  Printing)
 ; PROC = the name of the procedure
 S OTEMP=$S(XQY0["SUMMARY":"FP"_$G(MCPRO),1:$P(XQY0,U))
 S:$L($G(MCPRO))<2 MCPRO=$$MCPROP^MCARP(OTEMP)
 S MCARP="",(MCARP,MCARGNUM,MCARGNAM)=+$O(^MCAR(697.2,"B",MCPRO,MCARP)),OPTION=$E(OTEMP,3,4)
 S TEMP=$G(^MCAR(697.2,MCARP,0)),MCESS=0,MCSUP=+$P(TEMP,U,16)
 S (MCROUT,MCARDE)=$P(TEMP,U,8),MCFILE=+$P($P(TEMP,U,2),"MCAR(",2),MCESON=+$P(TEMP,U,14),MCESSEC=0,MCESKEY=$P(TEMP,U,15)
 S MCARGNAM=$P(TEMP,U),MCPATFLD=$P(TEMP,U,12),MCOUNT=0
 I MCESON,MCESKEY'="" S:$D(^XUSEC(MCESKEY,DUZ)) MCESSEC=1
 I MCFILE=699 S MCARCODE=$S($P(XQY0,U)["GI":"G",$P(XQY0,U)["NONENDO":"Z",1:"P"),DIC("S")="I $D(^MCAR(697.2,""D"",MCARCODE,+$P(^MCAR(699,+Y,0),U,12)))"
 S MCPRTRTN=$P(TEMP,U,5)_"^"_$P(TEMP,U,6)
 S MCBS=$S(OPTION["B":1,1:0) Q
 Q
DELETE ;DELETES GI PROCEDURES Taken from MCARGE routine for size
 S DIC="^MCAR(699,",DIC(0)="AEQM",DIC("A")="Select Patient Name or Date of Procedure to Delete:  ",DIC("S")="I $D(^MCAR(697.2,""D"",MCARCODE,$P(^MCAR(699,+Y,0),U,12)))"
 I MCESON S DIC("S")=DIC("S")_",$$SCRDEL^MCESSCR(699)"
 D ^DIC G EXIT:Y<0 S MCARGDA=+Y
 S DIR("A")="ARE YOU SURE YOU WANT TO DELETE",DIR("B")="N",DIR(0)="Y"
 D ^DIR
 I Y S DA=MCARGDA,DIK="^MCAR(699," D ^DIK W !!,"Procedure Deleted ",MCARGDA=0
 Q