- 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)
- 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)
