- 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 Jan 18, 2025@02:43:56 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