MDESPRT ;HOIFO/NCA - ELECTRONIC SIGNATURE PRINT ;12/21/04 09:24
;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
GETHDR(RESULTS,MDDP) ; Get Legal Header for Report Text
K ^TMP("MDTMP",$J) N MDC,MDFCHK,MDFT,MDS5,MDS6,X3,Y S (MDFCHK,MDFT)=0
N MCSTAT,TEMP,CODE,CREATION,FNAME,FT,FTYPE,NAME,NUM,TT,VERSION S MDC=7
S ^TMP("MDTMP",$J,1)="****************************************************************"
S ^TMP("MDTMP",$J,2)="This information was imported from the Medicine Package software"
S ^TMP("MDTMP",$J,3)="and does not include an electronic signature; therefore, it is"
S ^TMP("MDTMP",$J,4)="being administratively closed and should be used as information"
S ^TMP("MDTMP",$J,5)="only."
S ^TMP("MDTMP",$J,6)="****************************************************************"
S ^TMP("MDTMP",$J,7)=""
S MDS5=$P($P($G(MDDP),";",2),","),MDS5=+$P(MDS5,"(",2),MDS6=+MDDP
I $P($G(^MCAR(MDS5,MDS6,"ES")),U,7)=""!($P($G(^MCAR(MDS5,MDS6,"ES")),U,7)="RNV") S ^TMP("MDTMP",$J,8)=" CONVERTED ARCHIVED REPORT",MDC=MDC+1
F X3=0:0 S X3=$O(@RESULTS@(X3)) Q:'X3 D Q:+MDFCHK
.I $P($G(^MCAR(MDS5,MDS6,"ES")),U,7)="RNV"&($G(@RESULTS@(X3))["R e l e a s e S t a t u s") S MDFCHK=1 Q
.S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=$G(@RESULTS@(X3))
S TEMP=$G(^MCAR(MDS5,MDS6,"ES"))
I $P(TEMP,U,7)=""!($P(TEMP,U,7)="RNV") S MDFT=1
I +MDFT<1 K ^TMP($J) M ^TMP($J)=^TMP("MDTMP",$J) K ^TMP("MDTMP",$J) Q
I $P(TEMP,U,7)="RNV"&($G(^TMP("MDTMP",$J,MDC))[" - -") K ^TMP("MDTMP",$J,MDC) S MDC=MDC-1
S $P(TEMP,U,15)=DT
; Retrieve RC/ES Field (NA = Dont need)
S NAME="^^^^^^CODE^^^^^^^^CREATION",FTYPE="^^^^^^F^^^^^^^^D"
F TT=7,15 D
.S Y=$P(TEMP,U,TT),FT=$P(FTYPE,U,TT),FNAME=$P(NAME,U,TT)
.I Y S:FT="D" @FNAME=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E((1700+$E(Y,1,3)),3,4) S:FT="F" @FNAME=Y
S MCSTAT="CONVERTED ARCHIVED REPORT"
S NUM=1
S VERSION=NUM_" of "_NUM
S $P(SS," -",40)="" S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=""
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=""
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=""
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=SS K SS
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=$J(" ",18)_"R e p o r t R e l e a s e S t a t u s"
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=""
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)="Current "
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)="Report "_$J(" ",51)_"Date of Report"
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)="Status "_$J(" ",51)_" Entry Version"
S $P(SS,"=",80)="",MDC=MDC+1,^TMP("MDTMP",$J,MDC)=SS K SS
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=MCSTAT
S MDC=MDC+1,^TMP("MDTMP",$J,MDC)=$J(" ",59)_CREATION_" "_VERSION
K ^TMP($J) M ^TMP($J)=^TMP("MDTMP",$J) K ^TMP("MDTMP",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDESPRT 2641 printed Dec 13, 2024@01:42:42 Page 2
MDESPRT ;HOIFO/NCA - ELECTRONIC SIGNATURE PRINT ;12/21/04 09:24
+1 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
GETHDR(RESULTS,MDDP) ; Get Legal Header for Report Text
+1 KILL ^TMP("MDTMP",$JOB)
NEW MDC,MDFCHK,MDFT,MDS5,MDS6,X3,Y
SET (MDFCHK,MDFT)=0
+2 NEW MCSTAT,TEMP,CODE,CREATION,FNAME,FT,FTYPE,NAME,NUM,TT,VERSION
SET MDC=7
+3 SET ^TMP("MDTMP",$JOB,1)="****************************************************************"
+4 SET ^TMP("MDTMP",$JOB,2)="This information was imported from the Medicine Package software"
+5 SET ^TMP("MDTMP",$JOB,3)="and does not include an electronic signature; therefore, it is"
+6 SET ^TMP("MDTMP",$JOB,4)="being administratively closed and should be used as information"
+7 SET ^TMP("MDTMP",$JOB,5)="only."
+8 SET ^TMP("MDTMP",$JOB,6)="****************************************************************"
+9 SET ^TMP("MDTMP",$JOB,7)=""
+10 SET MDS5=$PIECE($PIECE($GET(MDDP),";",2),",")
SET MDS5=+$PIECE(MDS5,"(",2)
SET MDS6=+MDDP
+11 IF $PIECE($GET(^MCAR(MDS5,MDS6,"ES")),U,7)=""!($PIECE($GET(^MCAR(MDS5,MDS6,"ES")),U,7)="RNV")
SET ^TMP("MDTMP",$JOB,8)=" CONVERTED ARCHIVED REPORT"
SET MDC=MDC+1
+12 FOR X3=0:0
SET X3=$ORDER(@RESULTS@(X3))
if 'X3
QUIT
Begin DoDot:1
+13 IF $PIECE($GET(^MCAR(MDS5,MDS6,"ES")),U,7)="RNV"&($GET(@RESULTS@(X3))["R e l e a s e S t a t u s")
SET MDFCHK=1
QUIT
+14 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=$GET(@RESULTS@(X3))
End DoDot:1
if +MDFCHK
QUIT
+15 SET TEMP=$GET(^MCAR(MDS5,MDS6,"ES"))
+16 IF $PIECE(TEMP,U,7)=""!($PIECE(TEMP,U,7)="RNV")
SET MDFT=1
+17 IF +MDFT<1
KILL ^TMP($JOB)
MERGE ^TMP($JOB)=^TMP("MDTMP",$JOB)
KILL ^TMP("MDTMP",$JOB)
QUIT
+18 IF $PIECE(TEMP,U,7)="RNV"&($GET(^TMP("MDTMP",$JOB,MDC))[" - -")
KILL ^TMP("MDTMP",$JOB,MDC)
SET MDC=MDC-1
+19 SET $PIECE(TEMP,U,15)=DT
+20 ; Retrieve RC/ES Field (NA = Dont need)
+21 SET NAME="^^^^^^CODE^^^^^^^^CREATION"
SET FTYPE="^^^^^^F^^^^^^^^D"
+22 FOR TT=7,15
Begin DoDot:1
+23 SET Y=$PIECE(TEMP,U,TT)
SET FT=$PIECE(FTYPE,U,TT)
SET FNAME=$PIECE(NAME,U,TT)
+24 IF Y
if FT="D"
SET @FNAME=+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_$EXTRACT((1700+$EXTRACT(Y,1,3)),3,4)
if FT="F"
SET @FNAME=Y
End DoDot:1
+25 SET MCSTAT="CONVERTED ARCHIVED REPORT"
+26 SET NUM=1
+27 SET VERSION=NUM_" of "_NUM
+28 SET $PIECE(SS," -",40)=""
SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=""
+29 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=""
+30 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=""
+31 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=SS
KILL SS
+32 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=$JUSTIFY(" ",18)_"R e p o r t R e l e a s e S t a t u s"
+33 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=""
+34 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)="Current "
+35 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)="Report "_$JUSTIFY(" ",51)_"Date of Report"
+36 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)="Status "_$JUSTIFY(" ",51)_" Entry Version"
+37 SET $PIECE(SS,"=",80)=""
SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=SS
KILL SS
+38 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=MCSTAT
+39 SET MDC=MDC+1
SET ^TMP("MDTMP",$JOB,MDC)=$JUSTIFY(" ",59)_CREATION_" "_VERSION
+40 KILL ^TMP($JOB)
MERGE ^TMP($JOB)=^TMP("MDTMP",$JOB)
KILL ^TMP("MDTMP",$JOB)
+41 QUIT
