MCESPRT ;WISC/DCB-ELECTRONIC SIGNATURE PRINT ;6/26/96 12:51
;;2.3;Medicine;;09/13/1996
;
;
I $Y>(IOSL-12) D Q:$G(MCOUT)
.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
D DISPLAY
Q
DISPLAY ;
N CODE,ERROR,PART,PDUZ,SCRAMBLE,SDUZ,TDATE,TEMP,TRUE,TP,DIC,DR,DA,DIQ
N ENAME,EES,EDATE,VNAME,VES,VDATE,CODE,RELDATE,VERDATE,NA,MFD,MFDNAME,SUPD,CREATION,SUPNUM,SUPNUM,SUP1,SUP2,ROV,VERSION
N FT,FTYPE,FNAME,PERSON,DTEMP,X,X1,X2
I '$D(^MCAR(MCFILE,MCARGDA,"ES")) Q
S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
; Retrieve RC/ES Field (NA = Dont need"
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"
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"
S MCSTAT=$S(MFD:" Mark for Deletion",1:"X")
S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
S SCD=$S(MFD:EDATE,CODE["RV":VDATE,CODE["ROV":VDATE,CODE="RNV":RDATE,CODE="S":EDATE,1:EDATE)
S PERSON=$$DECODE(TEMP,CODE,MCFILE,MCARGDA)
S ROV=$S(CODE["ROV":"Signing for "_VNAME,1:""),SUPNUM=+SUPNUM,TSUP2=SUP2,SUPNUM=SUPNUM+1
S:'SUP2 NUM=SUPNUM
D:SUP2 VERSION
S VERSION=SUPNUM_" of "_NUM
S $P(SS," -",40)="" W !!!,SS K SS
W !,?18,"R e p o r t R e l e a s e S t a t u s",!
W !,"Current ",?19,"Date ",?28,"Person Who "
W !,"Report ",?19,$S(CODE["D":"Last",1:"Status"),?28,"Last "_$S(CODE["D":"Edited",1:"Changed"),?59,"Date of",?70,"Report"
W !,"Status ",?19,$S(CODE["D":"Edited",1:"Changed"),?28,$S(CODE["D":"Procedure",1:"The Status"),?59," Entry ",?70,"Version"
S $P(SS,"=",80)="" W !,SS K SS
W !,MCSTAT
W !,?19,SCD,?28,PERSON,?59,CREATION,?70,VERSION
W !,?28,ROV
K MCFILE1
Q
;Get and convert name and date
NAME S Y=$P($G(^VA(200,+Y,0)),U,1),@FNAME=$P(Y,",",2)_" "_$P(Y,",",1) Q
DATE S @FNAME=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E((1700+$E(Y,1,3)),3,4) Q
FREE S @FNAME=Y Q
VERSION ; Find the version number of a procedure
F NUM=SUPNUM:1 D CHECK Q:TSUP2=0
S NUM=NUM+1
Q
CHECK ; Find the number of times the report was superseded
S DTEMP=$G(^MCAR(MCFILE,TSUP2,"ES"))
S TSUP2=+$P(DTEMP,U,11)
Q
ENCODE(FILE,REC) ;Encode Validation Code
N CR,STR
S CR=$P($G(^VA(200,DUZ,20)),U,2)
S STR=$$SUM($G(^MCAR(FILE,REC,0)))
;Q $$ENCODER(CR,DUZ,STR)
Q $$ENCODER(CR,DUZ,REC)
ENCODER(X,X1,X2) ;Encode
D EN^XUSHSHP
Q X
DECODE(TEMP,CODE,FILE,REC) ;Decode the Validation code 1
N CR,PDUZ,STR,PER
S PRE=+$P(TEMP,U,1) S:PRE=0 PRE=DUZ
;Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD") $P($G(^VA(200,PRE,0)),U,1)
Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD")!(CODE="S") $P($G(^VA(200,PRE,0)),U,1) ;HUN-1095-22932
S CR=$P(TEMP,U,$S(CODE["RV":5,1:2))
S PDUZ=$P(TEMP,U,$S(CODE["RV":4,1:1))
S STR=$$SUM($G(^MCAR(MCFILE,REC,0)))
;Q $$DECODER(CR,PDUZ,STR)
Q $$DECODER(CR,PDUZ,REC)
;
DECODER(X,X1,X2) ;Decode the signature name
;X is the signuture block name.
;X1 is the DUZ of the person log on.
;X2 is either the report # or a checksum value of the report.
D DE^XUSHSHP
Q X
SUM(MCX) ;Create checksum value for string
N MCI,MCY
S MCY=0 F MCI=1:1:$L(MCX) S MCY=$A(MCX,MCI)*MCI+MCY
Q MCY
STATUS(MCFILE,MCARGDA) ; Get the status for the header
N CODE,TEMP,MFD
S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
S CODE=$P(TEMP,U,7)
S MFD=+$P(TEMP,U,12)
S MCSTAT=$S(MFD:"Mark for Deletion",1:"X")
S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
S MCARZ=MCARZ_" - "_MCSTAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESPRT 3592 printed Apr 09, 2024@21:17:56 Page 2
MCESPRT ;WISC/DCB-ELECTRONIC SIGNATURE PRINT ;6/26/96 12:51
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+1 IF $Y>(IOSL-12)
Begin DoDot:1
+2 SET MCY=""
if $EXTRACT(IOST,1,2)="C-"
READ !!,"Press return to continue, '^' to escape: ",MCY:DTIME
if '$TEST
SET MCY=U
if MCY=U
SET DN=0
SET MCOUT=1
if DN
DO HEAD^MCARP
KILL MCY
End DoDot:1
if $GET(MCOUT)
QUIT
+3 DO DISPLAY
+4 QUIT
DISPLAY ;
+1 NEW CODE,ERROR,PART,PDUZ,SCRAMBLE,SDUZ,TDATE,TEMP,TRUE,TP,DIC,DR,DA,DIQ
+2 NEW ENAME,EES,EDATE,VNAME,VES,VDATE,CODE,RELDATE,VERDATE,NA,MFD,MFDNAME,SUPD,CREATION,SUPNUM,SUPNUM,SUP1,SUP2,ROV,VERSION
+3 NEW FT,FTYPE,FNAME,PERSON,DTEMP,X,X1,X2
+4 IF '$DATA(^MCAR(MCFILE,MCARGDA,"ES"))
QUIT
+5 SET TEMP=$GET(^MCAR(MCFILE,MCARGDA,"ES"))
+6 ; Retrieve RC/ES Field (NA = Dont need"
+7 SET NAME="ENAME^NA^EDATE^VNAME^VES^VDATE^CODE^RDATE^VDATE^SUP1^SUP2^MFD^MFDNAME^SUPD^CREATION^SUPNUM"
SET FTYPE="P^X^D^P^F^D^F^D^D^F^F^F^P^D^D^F"
+8 FOR TT=1:1:16
Begin DoDot:1
End DoDot:1
SET Y=$PIECE(TEMP,U,TT)
SET FT=$PIECE(FTYPE,U,TT)
SET FNAME=$PIECE(NAME,U,TT)
if FT="D"
DO DATE
if FT="P"
DO NAME
if FT="F"
DO FREE
+9 SET MCSTAT=$SELECT(MFD:" Mark for Deletion",1:"X")
+10 if MCSTAT="X"
SET MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
+11 SET SCD=$SELECT(MFD:EDATE,CODE["RV":VDATE,CODE["ROV":VDATE,CODE="RNV":RDATE,CODE="S":EDATE,1:EDATE)
+12 SET PERSON=$$DECODE(TEMP,CODE,MCFILE,MCARGDA)
+13 SET ROV=$SELECT(CODE["ROV":"Signing for "_VNAME,1:"")
SET SUPNUM=+SUPNUM
SET TSUP2=SUP2
SET SUPNUM=SUPNUM+1
+14 if 'SUP2
SET NUM=SUPNUM
+15 if SUP2
DO VERSION
+16 SET VERSION=SUPNUM_" of "_NUM
+17 SET $PIECE(SS," -",40)=""
WRITE !!!,SS
KILL SS
+18 WRITE !,?18,"R e p o r t R e l e a s e S t a t u s",!
+19 WRITE !,"Current ",?19,"Date ",?28,"Person Who "
+20 WRITE !,"Report ",?19,$SELECT(CODE["D":"Last",1:"Status"),?28,"Last "_$SELECT(CODE["D":"Edited",1:"Changed"),?59,"Date of",?70,"Report"
+21 WRITE !,"Status ",?19,$SELECT(CODE["D":"Edited",1:"Changed"),?28,$SELECT(CODE["D":"Procedure",1:"The Status"),?59," Entry ",?70,"Version"
+22 SET $PIECE(SS,"=",80)=""
WRITE !,SS
KILL SS
+23 WRITE !,MCSTAT
+24 WRITE !,?19,SCD,?28,PERSON,?59,CREATION,?70,VERSION
+25 WRITE !,?28,ROV
+26 KILL MCFILE1
+27 QUIT
+28 ;Get and convert name and date
NAME SET Y=$PIECE($GET(^VA(200,+Y,0)),U,1)
SET @FNAME=$PIECE(Y,",",2)_" "_$PIECE(Y,",",1)
QUIT
DATE SET @FNAME=+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_$EXTRACT((1700+$EXTRACT(Y,1,3)),3,4)
QUIT
FREE SET @FNAME=Y
QUIT
VERSION ; Find the version number of a procedure
+1 FOR NUM=SUPNUM:1
DO CHECK
if TSUP2=0
QUIT
+2 SET NUM=NUM+1
+3 QUIT
CHECK ; Find the number of times the report was superseded
+1 SET DTEMP=$GET(^MCAR(MCFILE,TSUP2,"ES"))
+2 SET TSUP2=+$PIECE(DTEMP,U,11)
+3 QUIT
ENCODE(FILE,REC) ;Encode Validation Code
+1 NEW CR,STR
+2 SET CR=$PIECE($GET(^VA(200,DUZ,20)),U,2)
+3 SET STR=$$SUM($GET(^MCAR(FILE,REC,0)))
+4 ;Q $$ENCODER(CR,DUZ,STR)
+5 QUIT $$ENCODER(CR,DUZ,REC)
ENCODER(X,X1,X2) ;Encode
+1 DO EN^XUSHSHP
+2 QUIT X
DECODE(TEMP,CODE,FILE,REC) ;Decode the Validation code 1
+1 NEW CR,PDUZ,STR,PER
+2 SET PRE=+$PIECE(TEMP,U,1)
if PRE=0
SET PRE=DUZ
+3 ;Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD") $P($G(^VA(200,PRE,0)),U,1)
+4 ;HUN-1095-22932
if (CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD")!(CODE="S")
QUIT $PIECE($GET(^VA(200,PRE,0)),U,1)
+5 SET CR=$PIECE(TEMP,U,$SELECT(CODE["RV":5,1:2))
+6 SET PDUZ=$PIECE(TEMP,U,$SELECT(CODE["RV":4,1:1))
+7 SET STR=$$SUM($GET(^MCAR(MCFILE,REC,0)))
+8 ;Q $$DECODER(CR,PDUZ,STR)
+9 QUIT $$DECODER(CR,PDUZ,REC)
+10 ;
DECODER(X,X1,X2) ;Decode the signature name
+1 ;X is the signuture block name.
+2 ;X1 is the DUZ of the person log on.
+3 ;X2 is either the report # or a checksum value of the report.
+4 DO DE^XUSHSHP
+5 QUIT X
SUM(MCX) ;Create checksum value for string
+1 NEW MCI,MCY
+2 SET MCY=0
FOR MCI=1:1:$LENGTH(MCX)
SET MCY=$ASCII(MCX,MCI)*MCI+MCY
+3 QUIT MCY
STATUS(MCFILE,MCARGDA) ; Get the status for the header
+1 NEW CODE,TEMP,MFD
+2 SET TEMP=$GET(^MCAR(MCFILE,MCARGDA,"ES"))
+3 SET CODE=$PIECE(TEMP,U,7)
+4 SET MFD=+$PIECE(TEMP,U,12)
+5 SET MCSTAT=$SELECT(MFD:"Mark for Deletion",1:"X")
+6 if MCSTAT="X"
SET MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
+7 SET MCARZ=MCARZ_" - "_MCSTAT
+8 QUIT
