- 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 Feb 18, 2025@23:41:33 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