MCESEDT2 ;WISC/DCB-ELECTRONIC SIGNATURE EDITS PART 2 ;6/26/96 12:51
;;2.3;Medicine;;09/13/1996
EDD ; Draft
EDPD ; Problem Draft
S TEMP=DUZ_U_U_$$NOW(1)_"^^^^"_$$NUMTOES^MCESSCR(LOOP)_"^^^^^^^"
S:$P($G(^MCAR(MCFILE,REC,"ES")),U,14)="" TEMP=TEMP_"^"_$$NOW(1)
Q
EDRV ; Release On-line Verify
D SIGN Q:ERROR=1
S $P(TEMP,U,4)=DUZ,$P(TEMP,U,6)=$$NOW(1),$P(TEMP,U,8)=$$NOW(1),$P(TEMP,U,9)=$$NOW(1),$P(TEMP,U,2)="",$P(TEMP,U,3)="",$P(TEMP,U,5)=SCRAMBLE
Q
EDROV ; Release Off-Line Verify
D SIGN Q:ERROR=1
S DIR(0)="E",DIR("T")=30 D ^DIR K DIR,DIRUT,DTOUT,DIROUT
I $D(DUOUT) S TEMP=ORG,EXIT=1 K DUOUT Q
D HEADER^MCESEDT
W !!,IOBON,"Please enter a provider that you are signing for",IOBOFF
W !,"Note: This provider must have a key for ",IOUON,MCROUT,IOUOFF,!
S DIC=200,DIC(0)="AEQMZ"
S DIC("A")="Please select a Provider with a "_IOINHI_MCROUT_IOINORM_" key: "
S DIC("S")="I $D(^XUSEC(MCESKEY,Y)),(Y'=DUZ)" D ^DIC K DIC
S CDUZ=+Y
I $D(DUOUT)!($D(DTOUT))!(CDUZ<0) S EXIT=1,TEMP=ORG D:$G(SUP)="S" DELSS^MCESEDT Q
S $P(TEMP,U,1)=DUZ,$P(TEMP,U,3)=$$NOW(1),$P(TEMP,U,8)=$$NOW(1),$P(TEMP,U,9)=$$NOW(1),$P(TEMP,U,4)=CDUZ,$P(TEMP,U,2)=SCRAMBLE
Q
SIGN ; Display message, checks for elect. sign
I $P($G(^VA(200,DUZ,20)),U,4)="" D ERROR S ERROR=1 Q
W !!,"In order to "_IOUON_"release and verify"_IOUOFF_" procedure results",!,"you must type in your electronic signature code."
D SIG^XUSESIG S:X1="" ERROR=1
I ERROR=1 D HEADER^MCESEDT,ERROR Q
S SCRAMBLE=$$ENCODE^MCESPRT(MCFILE,MCARGDA)
Q
EDRNV ; Release Not Verify
I NCHANGE G EDRNV1
W !!,IOINHI,IOBON,*7,"This option should be used with extreme CAUTION.",IOINORM,IOBOFF
W !,"You can be held accountable for releasing unverified procedure results",!!
S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you "_IOUON_"still"_IOUOFF_" want to countinue" D ^DIR K DIR
I Y=0!$D(DIRUT) S EXIT=1 Q
EDRNV1 ;
W !!
S DIR("B")="NO",DIR(0)="Y"
S DIR("A",1)="Since this record is "_IOUON_"Released Not Verified"_IOUOFF
S DIR("A")="Do you want to mark this record for deletion"
S DIR("?",1)="When you "_IOUON_"mark a record for deletion"_IOUOFF_","
S DIR("?",2)="the record will be gone from your view and everyone else's"
S DIR("?",3)="view with the exception of the manager of "_IOUON_MCROUT_IOUOFF_"."
S DIR("?")="YES: Mark it for deletion NO: Don't mark it for deletion"
D ^DIR K DIR I $D(DIRUT) S EXIT=1 Q
I Y=1 S $P(TEMP,U,12)="1",$P(TEMP,U,13)=DUZ,$P(TEMP,U,3)=$$NOW(1)
I NCHANGE=0 S $P(TEMP,U,8)=$$NOW(1),$P(TEMP,U,9)="",$P(TEMP,U,1)=DUZ,$P(TEMP,U,3)=$$NOW(1)
Q
EDS ; Superseded
S MCESTEMP=ORG
W !!!,"You must sign a Superseded record in order to complete the process"
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you "_IOUON_"still"_IOUOFF_" want to countinue" D ^DIR K DIR
I Y=0!(Y=U)!(Y="") S EXIT=1 K MCBACK Q
S (X,MX)=$P(^MCAR(MCFILE,REC,0),U,1)
S NOW=$$NOW(X)
S PDATE=+$P(TEMP,U,15)
W !!,?14,IOBON,IODWL,IOUON,"Please Wait!",IOBOFF,IOUOFF
K DD,DO,DIC S HOLD="^MCAR("_MCFILE_",",DIC=HOLD,X=$P(^MCAR(MCFILE,REC,0),U,1),DIC(0)=""
D FILE^DICN S NEWREC=+Y
I +Y=-1 W !!,IOINHI,"An ",IOBON,"error",IOBOFF," has occured",!,"in creating the new record" S EXIT=1 Q
W !!,"Record "_REC_" copy to "_NEWREC_"."
S %X=HOLD_REC_",",%Y=HOLD_NEWREC_"," D %XY^%RCR
S ^MCAR(MCFILE,NEWREC,"ES")=DUZ_U_U_NOW_U_U_U_U_"D"_U_U_U_REC_U_U_U_U_PDATE_U_NOW
W !,"Indexing "_NEWREC_"." S DIK=HOLD,DA=NEWREC D IX^DIK K DIK
S $P(TEMP,U,11)=NEWREC,$P(TEMP,U,3)=NOW
S $P(TEMP,U,1)=DUZ,$P(TEMP,U,3)=NOW,$P(TEMP,U,8)=NOW,$P(TEMP,U,9)=NOW
W !!,"Your Procedure has been Copied",!,"You can now make changes to the copy."
W !,"New Record:",!
S DIC="^MCAR("_MCFILE_",",DIC(0)="EMQZ",X=" " D ^DIC K DIC
S MCY=Y,MCY(0)=Y(0),MCY(0,0)=Y(0,0)
S MCESPREV=REC,MCESCUR=NEWREC,MCBACK=1
S $P(^MCAR(MCFILE,NEWREC,"ES"),U,16)=+$P(TEMP,U,16)+1
K PDATE,NOW,TY,X,DTOUT,DUOUT,DIROUT
Q
EDSRV ; NO
EDSROV ; OP
Q
ERROR ;
K NEWST ;D HEADER^MCESEDT
W !!,IOINHI,IOBON,*7,"Your electronic signature is invalid or not declared.",IOINORM,IOBOFF
W !!,"You must declare an electronic signature or ask your IRM for help."
W !,"===> No changes to release status can be done. <===="
S TEMP=ORG,ERROR=1,EXIT=1
Q
ASK ;
S DIR("A")=IOINHI_"Please Select a New Status"_IOINORM
D ^DIR I $D(DIRUT) S EXIT=1
I Y=DIR("B"),(PROV>2) S EXIT=1
K DIR Q:EXIT=1
S NEWST=Y(0) D HEADER^MCESEDT Q
NOW(TA) ;
D NOW^%DTC Q $E(%,1,12)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESEDT2 4432 printed Apr 09, 2024@21:18:15 Page 2
MCESEDT2 ;WISC/DCB-ELECTRONIC SIGNATURE EDITS PART 2 ;6/26/96 12:51
+1 ;;2.3;Medicine;;09/13/1996
EDD ; Draft
EDPD ; Problem Draft
+1 SET TEMP=DUZ_U_U_$$NOW(1)_"^^^^"_$$NUMTOES^MCESSCR(LOOP)_"^^^^^^^"
+2 if $PIECE($GET(^MCAR(MCFILE,REC,"ES")),U,14)=""
SET TEMP=TEMP_"^"_$$NOW(1)
+3 QUIT
EDRV ; Release On-line Verify
+1 DO SIGN
if ERROR=1
QUIT
+2 SET $PIECE(TEMP,U,4)=DUZ
SET $PIECE(TEMP,U,6)=$$NOW(1)
SET $PIECE(TEMP,U,8)=$$NOW(1)
SET $PIECE(TEMP,U,9)=$$NOW(1)
SET $PIECE(TEMP,U,2)=""
SET $PIECE(TEMP,U,3)=""
SET $PIECE(TEMP,U,5)=SCRAMBLE
+3 QUIT
EDROV ; Release Off-Line Verify
+1 DO SIGN
if ERROR=1
QUIT
+2 SET DIR(0)="E"
SET DIR("T")=30
DO ^DIR
KILL DIR,DIRUT,DTOUT,DIROUT
+3 IF $DATA(DUOUT)
SET TEMP=ORG
SET EXIT=1
KILL DUOUT
QUIT
+4 DO HEADER^MCESEDT
+5 WRITE !!,IOBON,"Please enter a provider that you are signing for",IOBOFF
+6 WRITE !,"Note: This provider must have a key for ",IOUON,MCROUT,IOUOFF,!
+7 SET DIC=200
SET DIC(0)="AEQMZ"
+8 SET DIC("A")="Please select a Provider with a "_IOINHI_MCROUT_IOINORM_" key: "
+9 SET DIC("S")="I $D(^XUSEC(MCESKEY,Y)),(Y'=DUZ)"
DO ^DIC
KILL DIC
+10 SET CDUZ=+Y
+11 IF $DATA(DUOUT)!($DATA(DTOUT))!(CDUZ<0)
SET EXIT=1
SET TEMP=ORG
if $GET(SUP)="S"
DO DELSS^MCESEDT
QUIT
+12 SET $PIECE(TEMP,U,1)=DUZ
SET $PIECE(TEMP,U,3)=$$NOW(1)
SET $PIECE(TEMP,U,8)=$$NOW(1)
SET $PIECE(TEMP,U,9)=$$NOW(1)
SET $PIECE(TEMP,U,4)=CDUZ
SET $PIECE(TEMP,U,2)=SCRAMBLE
+13 QUIT
SIGN ; Display message, checks for elect. sign
+1 IF $PIECE($GET(^VA(200,DUZ,20)),U,4)=""
DO ERROR
SET ERROR=1
QUIT
+2 WRITE !!,"In order to "_IOUON_"release and verify"_IOUOFF_" procedure results",!,"you must type in your electronic signature code."
+3 DO SIG^XUSESIG
if X1=""
SET ERROR=1
+4 IF ERROR=1
DO HEADER^MCESEDT
DO ERROR
QUIT
+5 SET SCRAMBLE=$$ENCODE^MCESPRT(MCFILE,MCARGDA)
+6 QUIT
EDRNV ; Release Not Verify
+1 IF NCHANGE
GOTO EDRNV1
+2 WRITE !!,IOINHI,IOBON,*7,"This option should be used with extreme CAUTION.",IOINORM,IOBOFF
+3 WRITE !,"You can be held accountable for releasing unverified procedure results",!!
+4 SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you "_IOUON_"still"_IOUOFF_" want to countinue"
DO ^DIR
KILL DIR
+5 IF Y=0!$DATA(DIRUT)
SET EXIT=1
QUIT
EDRNV1 ;
+1 WRITE !!
+2 SET DIR("B")="NO"
SET DIR(0)="Y"
+3 SET DIR("A",1)="Since this record is "_IOUON_"Released Not Verified"_IOUOFF
+4 SET DIR("A")="Do you want to mark this record for deletion"
+5 SET DIR("?",1)="When you "_IOUON_"mark a record for deletion"_IOUOFF_","
+6 SET DIR("?",2)="the record will be gone from your view and everyone else's"
+7 SET DIR("?",3)="view with the exception of the manager of "_IOUON_MCROUT_IOUOFF_"."
+8 SET DIR("?")="YES: Mark it for deletion NO: Don't mark it for deletion"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET EXIT=1
QUIT
+10 IF Y=1
SET $PIECE(TEMP,U,12)="1"
SET $PIECE(TEMP,U,13)=DUZ
SET $PIECE(TEMP,U,3)=$$NOW(1)
+11 IF NCHANGE=0
SET $PIECE(TEMP,U,8)=$$NOW(1)
SET $PIECE(TEMP,U,9)=""
SET $PIECE(TEMP,U,1)=DUZ
SET $PIECE(TEMP,U,3)=$$NOW(1)
+12 QUIT
EDS ; Superseded
+1 SET MCESTEMP=ORG
+2 WRITE !!!,"You must sign a Superseded record in order to complete the process"
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you "_IOUON_"still"_IOUOFF_" want to countinue"
DO ^DIR
KILL DIR
+4 IF Y=0!(Y=U)!(Y="")
SET EXIT=1
KILL MCBACK
QUIT
+5 SET (X,MX)=$PIECE(^MCAR(MCFILE,REC,0),U,1)
+6 SET NOW=$$NOW(X)
+7 SET PDATE=+$PIECE(TEMP,U,15)
+8 WRITE !!,?14,IOBON,IODWL,IOUON,"Please Wait!",IOBOFF,IOUOFF
+9 KILL DD,DO,DIC
SET HOLD="^MCAR("_MCFILE_","
SET DIC=HOLD
SET X=$PIECE(^MCAR(MCFILE,REC,0),U,1)
SET DIC(0)=""
+10 DO FILE^DICN
SET NEWREC=+Y
+11 IF +Y=-1
WRITE !!,IOINHI,"An ",IOBON,"error",IOBOFF," has occured",!,"in creating the new record"
SET EXIT=1
QUIT
+12 WRITE !!,"Record "_REC_" copy to "_NEWREC_"."
+13 SET %X=HOLD_REC_","
SET %Y=HOLD_NEWREC_","
DO %XY^%RCR
+14 SET ^MCAR(MCFILE,NEWREC,"ES")=DUZ_U_U_NOW_U_U_U_U_"D"_U_U_U_REC_U_U_U_U_PDATE_U_NOW
+15 WRITE !,"Indexing "_NEWREC_"."
SET DIK=HOLD
SET DA=NEWREC
DO IX^DIK
KILL DIK
+16 SET $PIECE(TEMP,U,11)=NEWREC
SET $PIECE(TEMP,U,3)=NOW
+17 SET $PIECE(TEMP,U,1)=DUZ
SET $PIECE(TEMP,U,3)=NOW
SET $PIECE(TEMP,U,8)=NOW
SET $PIECE(TEMP,U,9)=NOW
+18 WRITE !!,"Your Procedure has been Copied",!,"You can now make changes to the copy."
+19 WRITE !,"New Record:",!
+20 SET DIC="^MCAR("_MCFILE_","
SET DIC(0)="EMQZ"
SET X=" "
DO ^DIC
KILL DIC
+21 SET MCY=Y
SET MCY(0)=Y(0)
SET MCY(0,0)=Y(0,0)
+22 SET MCESPREV=REC
SET MCESCUR=NEWREC
SET MCBACK=1
+23 SET $PIECE(^MCAR(MCFILE,NEWREC,"ES"),U,16)=+$PIECE(TEMP,U,16)+1
+24 KILL PDATE,NOW,TY,X,DTOUT,DUOUT,DIROUT
+25 QUIT
EDSRV ; NO
EDSROV ; OP
+1 QUIT
ERROR ;
+1 ;D HEADER^MCESEDT
KILL NEWST
+2 WRITE !!,IOINHI,IOBON,*7,"Your electronic signature is invalid or not declared.",IOINORM,IOBOFF
+3 WRITE !!,"You must declare an electronic signature or ask your IRM for help."
+4 WRITE !,"===> No changes to release status can be done. <===="
+5 SET TEMP=ORG
SET ERROR=1
SET EXIT=1
+6 QUIT
ASK ;
+1 SET DIR("A")=IOINHI_"Please Select a New Status"_IOINORM
+2 DO ^DIR
IF $DATA(DIRUT)
SET EXIT=1
+3 IF Y=DIR("B")
IF (PROV>2)
SET EXIT=1
+4 KILL DIR
if EXIT=1
QUIT
+5 SET NEWST=Y(0)
DO HEADER^MCESEDT
QUIT
NOW(TA) ;
+1 DO NOW^%DTC
QUIT $EXTRACT(%,1,12)
+2 QUIT
