- 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 Jan 18, 2025@03:16:21 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