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

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1MCEF ;WISC/MLH-FILEMAN ENTER/EDIT OF MED PROCS ;4/7/97 11:15
2 ;;2.3;Medicine;**8,15**;09/13/1996
3ENTED ;(MCARGNAM,FULBRIEF);enter/edit entry point
4 K DIC
5 D MCEPROC^MCARE
6 ; extract global loc, print name, full IT name, brief IT name, pat fld
7 S DIC(0)="AEQLMZ"
8 S (DIC,DIE)="^MCAR("_MCFILE_","
9 I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
10 I MCPRO="GEN" S DIC("S")="I '$P(^MCAR(699.5,+Y,0),U,3)"
11 S (DLAYGO,DIDEL)=MCFILE
12 D DATE^MCAREH
13 D ^DIC ; get record to edit
14 I Y<0 K DIC Q
15 S MCARGDA=+Y
16 I MCFILE=691.5,$D(^MCAR(MCFILE,MCARGDA,"A")) Q:'MCESON D ESRC^MCESSCR(MCFILE,.MCARGDA) G:$D(MCBACK) BACK Q ;RMP
17 I MCESON,("125"'[$$ESTONUM^MCESSCR(MCFILE,MCARGDA)) D ESRC^MCESSCR(MCFILE,.MCARGDA) Q:'$D(MCBACK)
18 D:$D(MCBACK) BACK
19 I Y'<0,MCFILE=699.5 N MCGEN S MCGEN=0 D GENEX^MCARGES(+Y,.MCGEN) Q:MCGEN
20 K DTOUT,DUOUT ;MC*2.3*8
21 D EDIT ;edit the record
22 ;D ESRC^MCESSCR(MCFILE,MCARGDA) ;MC*2.3*8, MOVED DOWN
23 K MCBACK,DIR,DIC,MCFILE,MCARGDA,DA,DFN,DR,MCPATNM,DTOUT,DUOUT
24 Q
25EDIT ;
26 ;N DA,DFN,DR,MCARGDA
27 S (MCARGDA,DA)=+Y ; record number
28 ; choose and format input template
29 S DR="["_MCEPROC_"]"
30 S DFN=$P(Y(0),U,2)
31 D IN^MCEO ; order entry
32 ;I '$D(DUOUT),'$D(DTOUT) D EDIT2
33 I '$D(DUOUT) D EDIT2 ;MC*2.3*8
34 Q
35EDIT2 ;
36 D ^DIE ; edit the record
37 I '$D(DA),$D(MCBACK) D BACKSS^MCESEDT K MCBACK
38 Q:'$D(DA)
39 I MCFILE=699.5 N MCGEN S MCGEN=0 D GENEX^MCARGES(MCARGDA,.MCGEN) Q:MCGEN
40 I '$D(DUOUT) D EDIT3 ;MC*2.3*8
41 Q
42EDIT3 ;
43 S DR=MCPATFLD,DA=MCARGDA,DIQ(0)="E"
44 S DIC="^MCAR("_MCFILE_"," ; WAA 5/14/96
45 D EN^DIQ1
46 S MCPATNM=$G(^UTILITY("DIQ1",$J,MCFILE,DA,MCPATFLD,"E"))
47 I $L(MCPOSTP)>1 S X=MCPOSTP X ^%ZOSF("TEST") D:$T @MCPOSTP
48 Q:$D(DUOUT) ;MC*2.3*8
49 D OUT^MCEO,PCC^MCARE1 ; order entry, PCC
50 Q:$D(DUOUT) ;MC*2.3*8
51 D ESRC^MCESSCR(MCFILE,MCARGDA) ;MC*2.3*8
52 Q
53BACK ;Set Y to the new record and allow the user to edit the new record
54 S Y=MCY,Y(0)=MCY(0),Y(0,0)=MCY(0,0),MCARGDA=+Y K MCY,DIROUT,DUOUT,DTOUT,EXIT
55 Q
56MCSEX(DFN) ;
57 N MCSEX,VADM
58 I '$D(DFN) S DFN=$P(@(DIC_DA_",0)"),U,2)
59 D DEM^VADPT
60 S MCSEX=$P(VADM(5),U,1)
61 ;D KVAR^VADPT
62 Q $S(MCSEX="M":1,MCSEX="F":2,1:0)
Note: See TracBrowser for help on using the repository browser.