source: FOIAVistA/trunk/r/MEDICINE-MC/MCESPRT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1MCESPRT ;WISC/DCB-ELECTRONIC SIGNATURE PRINT ;6/26/96 12:51
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5FOOTER(MCFILE,MCARGDA) ;
6 I $Y>(IOSL-12) D Q:$G(MCOUT)
7 .S MCY="" R:$E(IOST,1,2)="C-" !!,"Press return to continue, '^' to escape: ",MCY:DTIME S:'$T MCY=U S:MCY=U DN=0,MCOUT=1 D:DN HEAD^MCARP K MCY
8 D DISPLAY
9 Q
10DISPLAY ;
11 N CODE,ERROR,PART,PDUZ,SCRAMBLE,SDUZ,TDATE,TEMP,TRUE,TP,DIC,DR,DA,DIQ
12 N ENAME,EES,EDATE,VNAME,VES,VDATE,CODE,RELDATE,VERDATE,NA,MFD,MFDNAME,SUPD,CREATION,SUPNUM,SUPNUM,SUP1,SUP2,ROV,VERSION
13 N FT,FTYPE,FNAME,PERSON,DTEMP,X,X1,X2
14 I '$D(^MCAR(MCFILE,MCARGDA,"ES")) Q
15 S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
16 ; Retrieve RC/ES Field (NA = Dont need"
17 S NAME="ENAME^NA^EDATE^VNAME^VES^VDATE^CODE^RDATE^VDATE^SUP1^SUP2^MFD^MFDNAME^SUPD^CREATION^SUPNUM",FTYPE="P^X^D^P^F^D^F^D^D^F^F^F^P^D^D^F"
18 F TT=1:1:16 D S Y=$P(TEMP,U,TT),FT=$P(FTYPE,U,TT),FNAME=$P(NAME,U,TT) D DATE:FT="D",NAME:FT="P",FREE:FT="F"
19 S MCSTAT=$S(MFD:" Mark for Deletion",1:"X")
20 S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
21 S SCD=$S(MFD:EDATE,CODE["RV":VDATE,CODE["ROV":VDATE,CODE="RNV":RDATE,CODE="S":EDATE,1:EDATE)
22 S PERSON=$$DECODE(TEMP,CODE,MCFILE,MCARGDA)
23 S ROV=$S(CODE["ROV":"Signing for "_VNAME,1:""),SUPNUM=+SUPNUM,TSUP2=SUP2,SUPNUM=SUPNUM+1
24 S:'SUP2 NUM=SUPNUM
25 D:SUP2 VERSION
26 S VERSION=SUPNUM_" of "_NUM
27 S $P(SS," -",40)="" W !!!,SS K SS
28 W !,?18,"R e p o r t R e l e a s e S t a t u s",!
29 W !,"Current ",?19,"Date ",?28,"Person Who "
30 W !,"Report ",?19,$S(CODE["D":"Last",1:"Status"),?28,"Last "_$S(CODE["D":"Edited",1:"Changed"),?59,"Date of",?70,"Report"
31 W !,"Status ",?19,$S(CODE["D":"Edited",1:"Changed"),?28,$S(CODE["D":"Procedure",1:"The Status"),?59," Entry ",?70,"Version"
32 S $P(SS,"=",80)="" W !,SS K SS
33 W !,MCSTAT
34 W !,?19,SCD,?28,PERSON,?59,CREATION,?70,VERSION
35 W !,?28,ROV
36 K MCFILE1
37 Q
38 ;Get and convert name and date
39NAME S Y=$P($G(^VA(200,+Y,0)),U,1),@FNAME=$P(Y,",",2)_" "_$P(Y,",",1) Q
40DATE S @FNAME=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E((1700+$E(Y,1,3)),3,4) Q
41FREE S @FNAME=Y Q
42VERSION ; Find the version number of a procedure
43 F NUM=SUPNUM:1 D CHECK Q:TSUP2=0
44 S NUM=NUM+1
45 Q
46CHECK ; Find the number of times the report was superseded
47 S DTEMP=$G(^MCAR(MCFILE,TSUP2,"ES"))
48 S TSUP2=+$P(DTEMP,U,11)
49 Q
50ENCODE(FILE,REC) ;Encode Validation Code
51 N CR,STR
52 S CR=$P($G(^VA(200,DUZ,20)),U,2)
53 S STR=$$SUM($G(^MCAR(FILE,REC,0)))
54 ;Q $$ENCODER(CR,DUZ,STR)
55 Q $$ENCODER(CR,DUZ,REC)
56ENCODER(X,X1,X2) ;Encode
57 D EN^XUSHSHP
58 Q X
59DECODE(TEMP,CODE,FILE,REC) ;Decode the Validation code 1
60 N CR,PDUZ,STR,PER
61 S PRE=+$P(TEMP,U,1) S:PRE=0 PRE=DUZ
62 ;Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD") $P($G(^VA(200,PRE,0)),U,1)
63 Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD")!(CODE="S") $P($G(^VA(200,PRE,0)),U,1) ;HUN-1095-22932
64 S CR=$P(TEMP,U,$S(CODE["RV":5,1:2))
65 S PDUZ=$P(TEMP,U,$S(CODE["RV":4,1:1))
66 S STR=$$SUM($G(^MCAR(MCFILE,REC,0)))
67 ;Q $$DECODER(CR,PDUZ,STR)
68 Q $$DECODER(CR,PDUZ,REC)
69 ;
70DECODER(X,X1,X2) ;Decode the signature name
71 ;X is the signuture block name.
72 ;X1 is the DUZ of the person log on.
73 ;X2 is either the report # or a checksum value of the report.
74 D DE^XUSHSHP
75 Q X
76SUM(MCX) ;Create checksum value for string
77 N MCI,MCY
78 S MCY=0 F MCI=1:1:$L(MCX) S MCY=$A(MCX,MCI)*MCI+MCY
79 Q MCY
80STATUS(MCFILE,MCARGDA) ; Get the status for the header
81 N CODE,TEMP,MFD
82 S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
83 S CODE=$P(TEMP,U,7)
84 S MFD=+$P(TEMP,U,12)
85 S MCSTAT=$S(MFD:"Mark for Deletion",1:"X")
86 S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
87 S MCARZ=MCARZ_" - "_MCSTAT
88 Q
Note: See TracBrowser for help on using the repository browser.