| 1 | MCARP1 ;WISC/TJK-PRINT ROUTINES TWO ;5/3/96 08:18
|
|---|
| 2 | ;;2.3;Medicine;**14,15,16**;09/13/1996
|
|---|
| 3 | EXIT ;
|
|---|
| 4 | I IOST'?1"P-".E,'$D(MCOUT),$G(Y)'<0 R !!,"* END * Press return to continue: ",X:DTIME
|
|---|
| 5 | K ^UTILITY($J),IO("Q"),MCARGDA,MCARGDT,SSN,MCOUT,VA,DICMX,V
|
|---|
| 6 | K MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE
|
|---|
| 7 | K DIOEND,DIOBEG,DI,DIC,DJ,BY,A,DICSS,MCARGDT2,MCARPPS
|
|---|
| 8 | K DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
|
|---|
| 9 | 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
|
|---|
| 10 | K MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
|
|---|
| 11 | K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCARPS,MCSUP
|
|---|
| 12 | K MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCSTAT
|
|---|
| 13 | K MCARCODE,MCARDE,MCARGNAM,MCARGNUM,MCARGRTN,MCARP,MCARZ,MCBS
|
|---|
| 14 | K MCESS,MCESSEC,MCOUNT,MCPATFLD,MCPRO,MCSUP
|
|---|
| 15 | K ZTQUEUED,ZTREQ,FULL,MCPROP
|
|---|
| 16 | D ^%ZISC
|
|---|
| 17 | Q
|
|---|
| 18 | INIT(MCARZ,MCARGDT,MCFILE) ;
|
|---|
| 19 | S PG=0
|
|---|
| 20 | I '$D(MCARGDT2) S X=MCARGDT D DTIME^MCARP S MCARGDT2=X
|
|---|
| 21 | D NOW^%DTC S X=% D DTIME^MCARP S MCARDTM=X
|
|---|
| 22 | ; ------------------------
|
|---|
| 23 | ; SSN = Enternal Format of the patients SSN with the first letter
|
|---|
| 24 | ; of the last name tacked on the end
|
|---|
| 25 | ; ------------------------
|
|---|
| 26 | D DEM^VADPT S MCARGNM=VADM(1),SSN=VA("PID"),X=$P(VADM(3),"^",2),MCARDOB=$S(X'="":X,1:"")
|
|---|
| 27 | I MCFILE=699,($G(MCARGNUM)'="") S MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|---|
| 28 | D KVAR^VADPT
|
|---|
| 29 | D INP^VADPT S MCARWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MCARRB=VAIN(5) D KVAR^VADPT
|
|---|
| 30 | S MCARHDR=" CONFIDENTIAL "_MCARZ,MCAR="",$P(MCAR,"*",(77-$L(MCARHDR))\2)="*",MCARHDR=MCAR_" "_MCARHDR_" "_MCAR
|
|---|
| 31 | Q
|
|---|
| 32 | MCPPROC ; Get require variables
|
|---|
| 33 | N OTEMP,TEMP,OPTION
|
|---|
| 34 | ;MCabPROC <=== name of an option, screen or line edit.
|
|---|
| 35 | ; a = (B => Brief), (F => Full)
|
|---|
| 36 | ; b = (S => Screen Edit), (L => Line Edit), (P => Printing)
|
|---|
| 37 | ; PROC = the name of the procedure
|
|---|
| 38 | S OTEMP=$S(XQY0["SUMMARY":"FP"_$G(MCPRO),1:$P(XQY0,U))
|
|---|
| 39 | S:$L($G(MCPRO))<2 MCPRO=$$MCPROP^MCARP(OTEMP)
|
|---|
| 40 | S MCARP="",(MCARP,MCARGNUM,MCARGNAM)=+$O(^MCAR(697.2,"B",MCPRO,MCARP)),OPTION=$E(OTEMP,3,4)
|
|---|
| 41 | S TEMP=$G(^MCAR(697.2,MCARP,0)),MCESS=0,MCSUP=+$P(TEMP,U,16)
|
|---|
| 42 | 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)
|
|---|
| 43 | S MCARGNAM=$P(TEMP,U),MCPATFLD=$P(TEMP,U,12),MCOUNT=0
|
|---|
| 44 | I MCESON,MCESKEY'="" S:$D(^XUSEC(MCESKEY,DUZ)) MCESSEC=1
|
|---|
| 45 | 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)))"
|
|---|
| 46 | S MCPRTRTN=$P(TEMP,U,5)_"^"_$P(TEMP,U,6)
|
|---|
| 47 | S MCBS=$S(OPTION["B":1,1:0) Q
|
|---|
| 48 | Q
|
|---|
| 49 | DELETE ;DELETES GI PROCEDURES Taken from MCARGE routine for size
|
|---|
| 50 | 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)))"
|
|---|
| 51 | I MCESON S DIC("S")=DIC("S")_",$$SCRDEL^MCESSCR(699)"
|
|---|
| 52 | D ^DIC G EXIT:Y<0 S MCARGDA=+Y
|
|---|
| 53 | S DIR("A")="ARE YOU SURE YOU WANT TO DELETE",DIR("B")="N",DIR(0)="Y"
|
|---|
| 54 | D ^DIR
|
|---|
| 55 | I Y S DA=MCARGDA,DIK="^MCAR(699," D ^DIK W !!,"Procedure Deleted ",MCARGDA=0
|
|---|
| 56 | Q
|
|---|
