Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCESPRT

MCESPRT.m

Go to the documentation of this file.
  1. MCESPRT ;WISC/DCB-ELECTRONIC SIGNATURE PRINT ;6/26/96 12:51
  1. ;;2.3;Medicine;;09/13/1996
  1. ;
  1. ;
  1. I $Y>(IOSL-12) D Q:$G(MCOUT)
  1. .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
  1. D DISPLAY
  1. Q
  1. DISPLAY ;
  1. N CODE,ERROR,PART,PDUZ,SCRAMBLE,SDUZ,TDATE,TEMP,TRUE,TP,DIC,DR,DA,DIQ
  1. N ENAME,EES,EDATE,VNAME,VES,VDATE,CODE,RELDATE,VERDATE,NA,MFD,MFDNAME,SUPD,CREATION,SUPNUM,SUPNUM,SUP1,SUP2,ROV,VERSION
  1. N FT,FTYPE,FNAME,PERSON,DTEMP,X,X1,X2
  1. I '$D(^MCAR(MCFILE,MCARGDA,"ES")) Q
  1. S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
  1. ; Retrieve RC/ES Field (NA = Dont need"
  1. 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"
  1. 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"
  1. S MCSTAT=$S(MFD:" Mark for Deletion",1:"X")
  1. S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
  1. S SCD=$S(MFD:EDATE,CODE["RV":VDATE,CODE["ROV":VDATE,CODE="RNV":RDATE,CODE="S":EDATE,1:EDATE)
  1. S PERSON=$$DECODE(TEMP,CODE,MCFILE,MCARGDA)
  1. S ROV=$S(CODE["ROV":"Signing for "_VNAME,1:""),SUPNUM=+SUPNUM,TSUP2=SUP2,SUPNUM=SUPNUM+1
  1. S:'SUP2 NUM=SUPNUM
  1. D:SUP2 VERSION
  1. S VERSION=SUPNUM_" of "_NUM
  1. S $P(SS," -",40)="" W !!!,SS K SS
  1. W !,?18,"R e p o r t R e l e a s e S t a t u s",!
  1. W !,"Current ",?19,"Date ",?28,"Person Who "
  1. W !,"Report ",?19,$S(CODE["D":"Last",1:"Status"),?28,"Last "_$S(CODE["D":"Edited",1:"Changed"),?59,"Date of",?70,"Report"
  1. W !,"Status ",?19,$S(CODE["D":"Edited",1:"Changed"),?28,$S(CODE["D":"Procedure",1:"The Status"),?59," Entry ",?70,"Version"
  1. S $P(SS,"=",80)="" W !,SS K SS
  1. W !,MCSTAT
  1. W !,?19,SCD,?28,PERSON,?59,CREATION,?70,VERSION
  1. W !,?28,ROV
  1. K MCFILE1
  1. Q
  1. ;Get and convert name and date
  1. NAME S Y=$P($G(^VA(200,+Y,0)),U,1),@FNAME=$P(Y,",",2)_" "_$P(Y,",",1) Q
  1. DATE S @FNAME=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E((1700+$E(Y,1,3)),3,4) Q
  1. FREE S @FNAME=Y Q
  1. VERSION ; Find the version number of a procedure
  1. F NUM=SUPNUM:1 D CHECK Q:TSUP2=0
  1. S NUM=NUM+1
  1. Q
  1. CHECK ; Find the number of times the report was superseded
  1. S DTEMP=$G(^MCAR(MCFILE,TSUP2,"ES"))
  1. S TSUP2=+$P(DTEMP,U,11)
  1. Q
  1. ENCODE(FILE,REC) ;Encode Validation Code
  1. N CR,STR
  1. S CR=$P($G(^VA(200,DUZ,20)),U,2)
  1. S STR=$$SUM($G(^MCAR(FILE,REC,0)))
  1. ;Q $$ENCODER(CR,DUZ,STR)
  1. Q $$ENCODER(CR,DUZ,REC)
  1. ENCODER(X,X1,X2) ;Encode
  1. D EN^XUSHSHP
  1. Q X
  1. DECODE(TEMP,CODE,FILE,REC) ;Decode the Validation code 1
  1. N CR,PDUZ,STR,PER
  1. S PRE=+$P(TEMP,U,1) S:PRE=0 PRE=DUZ
  1. ;Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD") $P($G(^VA(200,PRE,0)),U,1)
  1. Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD")!(CODE="S") $P($G(^VA(200,PRE,0)),U,1) ;HUN-1095-22932
  1. S CR=$P(TEMP,U,$S(CODE["RV":5,1:2))
  1. S PDUZ=$P(TEMP,U,$S(CODE["RV":4,1:1))
  1. S STR=$$SUM($G(^MCAR(MCFILE,REC,0)))
  1. ;Q $$DECODER(CR,PDUZ,STR)
  1. Q $$DECODER(CR,PDUZ,REC)
  1. ;
  1. DECODER(X,X1,X2) ;Decode the signature name
  1. ;X is the signuture block name.
  1. ;X1 is the DUZ of the person log on.
  1. ;X2 is either the report # or a checksum value of the report.
  1. D DE^XUSHSHP
  1. Q X
  1. SUM(MCX) ;Create checksum value for string
  1. N MCI,MCY
  1. S MCY=0 F MCI=1:1:$L(MCX) S MCY=$A(MCX,MCI)*MCI+MCY
  1. Q MCY
  1. STATUS(MCFILE,MCARGDA) ; Get the status for the header
  1. N CODE,TEMP,MFD
  1. S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES"))
  1. S CODE=$P(TEMP,U,7)
  1. S MFD=+$P(TEMP,U,12)
  1. S MCSTAT=$S(MFD:"Mark for Deletion",1:"X")
  1. S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MCFILE,CODE)
  1. S MCARZ=MCARZ_" - "_MCSTAT
  1. Q