MCEF ;WISC/MLH-FILEMAN ENTER/EDIT OF MED PROCS ;4/7/97 11:15
;;2.3;Medicine;**8,15,42**;09/13/1996;Build 1
; Reference DBIA #10061[Supported] call to VADPT
ENTED ;(MCARGNAM,FULBRIEF);enter/edit entry point
K DIC
D MCEPROC^MCARE
; extract global loc, print name, full IT name, brief IT name, pat fld
S DIC(0)="AEQLMZ"
S (DIC,DIE)="^MCAR("_MCFILE_","
I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
I MCPRO="GEN" S DIC("S")="I '$P(^MCAR(699.5,+Y,0),U,3)"
S (DLAYGO,DIDEL)=MCFILE
D DATE^MCAREH
D ^DIC ; get record to edit
I Y<0 K DIC Q
S MCARGDA=+Y
I MCFILE=691.5,$D(^MCAR(MCFILE,MCARGDA,"A")) Q:'MCESON D ESRC^MCESSCR(MCFILE,.MCARGDA) G:$D(MCBACK) BACK Q ;RMP
I MCESON,("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA)) D ESRC^MCESSCR(MCFILE,.MCARGDA) Q:'$D(MCBACK)
D:$D(MCBACK) BACK
I Y'<0,MCFILE=699.5 N MCGEN S MCGEN=0 D GENEX^MCARGES(+Y,.MCGEN) Q:MCGEN
K DTOUT,DUOUT ;MC*2.3*8
D EDIT ;edit the record
;D ESRC^MCESSCR(MCFILE,MCARGDA) ;MC*2.3*8, MOVED DOWN
K MCBACK,DIR,DIC,MCFILE,MCARGDA,DA,DFN,DR,MCPATNM,DTOUT,DUOUT
Q
EDIT ;
;N DA,DFN,DR,MCARGDA
S (MCARGDA,DA)=+Y ; record number
; choose and format input template
S DR="["_MCEPROC_"]"
S DFN=$P(Y(0),U,2)
D IN^MCEO ; order entry
;I '$D(DUOUT),'$D(DTOUT) D EDIT2
I '$D(DUOUT) D EDIT2 ;MC*2.3*8
Q
EDIT2 ;
D ^DIE ; edit the record
I '$D(DA),$D(MCBACK) D BACKSS^MCESEDT K MCBACK
Q:'$D(DA)
I MCFILE=699.5 N MCGEN S MCGEN=0 D GENEX^MCARGES(MCARGDA,.MCGEN) Q:MCGEN
I '$D(DUOUT) D EDIT3 ;MC*2.3*8
Q
EDIT3 ;
S DR=MCPATFLD,DA=MCARGDA,DIQ(0)="E"
S DIC="^MCAR("_MCFILE_"," ; WAA 5/14/96
D EN^DIQ1
S MCPATNM=$G(^UTILITY("DIQ1",$J,MCFILE,DA,MCPATFLD,"E"))
I $L(MCPOSTP)>1 S X=MCPOSTP X ^%ZOSF("TEST") D:$T @MCPOSTP
Q:$D(DUOUT) ;MC*2.3*8
D OUT^MCEO,PCC^MCARE1 ; order entry, PCC
Q:$D(DUOUT) ;MC*2.3*8
D ESRC^MCESSCR(MCFILE,MCARGDA) ;MC*2.3*8
Q
BACK ;Set Y to the new record and allow the user to edit the new record
S Y=MCY,Y(0)=MCY(0),Y(0,0)=MCY(0,0),MCARGDA=+Y K MCY,DIROUT,DUOUT,DTOUT,EXIT
Q
MCSEX(DFN) ;
N MCSEX,VADM
; Due to Patient data merge the DIC error out referencing file 690
; Uncomment next line if patching MCEF.
S:DIC="^MCAR(690," DIC="^MCAR(700,"
I '$D(DFN) S DFN=$P(@(DIC_DA_",0)"),U,2)
D DEM^VADPT
S MCSEX=$P(VADM(5),U,1)
;D KVAR^VADPT
Q $S(MCSEX="M":1,MCSEX="F":2,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCEF 2373 printed Nov 22, 2024@17:24:59 Page 2
MCEF ;WISC/MLH-FILEMAN ENTER/EDIT OF MED PROCS ;4/7/97 11:15
+1 ;;2.3;Medicine;**8,15,42**;09/13/1996;Build 1
+2 ; Reference DBIA #10061[Supported] call to VADPT
ENTED ;(MCARGNAM,FULBRIEF);enter/edit entry point
+1 KILL DIC
+2 DO MCEPROC^MCARE
+3 ; extract global loc, print name, full IT name, brief IT name, pat fld
+4 SET DIC(0)="AEQLMZ"
+5 SET (DIC,DIE)="^MCAR("_MCFILE_","
+6 IF MCESON
SET DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
+7 IF MCPRO="GEN"
SET DIC("S")="I '$P(^MCAR(699.5,+Y,0),U,3)"
+8 SET (DLAYGO,DIDEL)=MCFILE
+9 DO DATE^MCAREH
+10 ; get record to edit
DO ^DIC
+11 IF Y<0
KILL DIC
QUIT
+12 SET MCARGDA=+Y
+13 ;RMP
IF MCFILE=691.5
IF $DATA(^MCAR(MCFILE,MCARGDA,"A"))
if 'MCESON
QUIT
DO ESRC^MCESSCR(MCFILE,.MCARGDA)
if $DATA(MCBACK)
GOTO BACK
QUIT
+14 IF MCESON
IF ("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA))
DO ESRC^MCESSCR(MCFILE,.MCARGDA)
if '$DATA(MCBACK)
QUIT
+15 if $DATA(MCBACK)
DO BACK
+16 IF Y'<0
IF MCFILE=699.5
NEW MCGEN
SET MCGEN=0
DO GENEX^MCARGES(+Y,.MCGEN)
if MCGEN
QUIT
+17 ;MC*2.3*8
KILL DTOUT,DUOUT
+18 ;edit the record
DO EDIT
+19 ;D ESRC^MCESSCR(MCFILE,MCARGDA) ;MC*2.3*8, MOVED DOWN
+20 KILL MCBACK,DIR,DIC,MCFILE,MCARGDA,DA,DFN,DR,MCPATNM,DTOUT,DUOUT
+21 QUIT
EDIT ;
+1 ;N DA,DFN,DR,MCARGDA
+2 ; record number
SET (MCARGDA,DA)=+Y
+3 ; choose and format input template
+4 SET DR="["_MCEPROC_"]"
+5 SET DFN=$PIECE(Y(0),U,2)
+6 ; order entry
DO IN^MCEO
+7 ;I '$D(DUOUT),'$D(DTOUT) D EDIT2
+8 ;MC*2.3*8
IF '$DATA(DUOUT)
DO EDIT2
+9 QUIT
EDIT2 ;
+1 ; edit the record
DO ^DIE
+2 IF '$DATA(DA)
IF $DATA(MCBACK)
DO BACKSS^MCESEDT
KILL MCBACK
+3 if '$DATA(DA)
QUIT
+4 IF MCFILE=699.5
NEW MCGEN
SET MCGEN=0
DO GENEX^MCARGES(MCARGDA,.MCGEN)
if MCGEN
QUIT
+5 ;MC*2.3*8
IF '$DATA(DUOUT)
DO EDIT3
+6 QUIT
EDIT3 ;
+1 SET DR=MCPATFLD
SET DA=MCARGDA
SET DIQ(0)="E"
+2 ; WAA 5/14/96
SET DIC="^MCAR("_MCFILE_","
+3 DO EN^DIQ1
+4 SET MCPATNM=$GET(^UTILITY("DIQ1",$JOB,MCFILE,DA,MCPATFLD,"E"))
+5 IF $LENGTH(MCPOSTP)>1
SET X=MCPOSTP
XECUTE ^%ZOSF("TEST")
if $TEST
DO @MCPOSTP
+6 ;MC*2.3*8
if $DATA(DUOUT)
QUIT
+7 ; order entry, PCC
DO OUT^MCEO
DO PCC^MCARE1
+8 ;MC*2.3*8
if $DATA(DUOUT)
QUIT
+9 ;MC*2.3*8
DO ESRC^MCESSCR(MCFILE,MCARGDA)
+10 QUIT
BACK ;Set Y to the new record and allow the user to edit the new record
+1 SET Y=MCY
SET Y(0)=MCY(0)
SET Y(0,0)=MCY(0,0)
SET MCARGDA=+Y
KILL MCY,DIROUT,DUOUT,DTOUT,EXIT
+2 QUIT
MCSEX(DFN) ;
+1 NEW MCSEX,VADM
+2 ; Due to Patient data merge the DIC error out referencing file 690
+3 ; Uncomment next line if patching MCEF.
+4 if DIC="^MCAR(690,"
SET DIC="^MCAR(700,"
+5 IF '$DATA(DFN)
SET DFN=$PIECE(@(DIC_DA_",0)"),U,2)
+6 DO DEM^VADPT
+7 SET MCSEX=$PIECE(VADM(5),U,1)
+8 ;D KVAR^VADPT
+9 QUIT $SELECT(MCSEX="M":1,MCSEX="F":2,1:0)
