- MCESEDT ;WISC/DCB-ELECTRONIC SIGNATURE PART 1 ; 2/6/03 9:15am
- ;;2.3;Medicine;**18,37,47**;09/13/1996;Build 12
- ;
- ;DE4487 - Call to HMP freshness stream
- POST(MCFILE,MCREC) ;Get the info about screen and set-up for edit.
- Q:'MCESON
- D ENS^%ZISS
- N ERROR,HDUZ,HOLD,LOOP,MDAT1,MDAT2,NAME,REC,NEWREC,NEWST,ORG,PROV,RNV,SCRAMBLE,SREC,STATUS,TDATE,TEMP,TEMP1,TY,X1,XDUZ,NCHANGE,LINE,XDATE,DIE,DA,DR,CREAT,SUP,DJDN,CODE,CDUZ,EE,DTOUT,DUOUT,DIRUT,DIROUT
- S RNV=+$P($G(^MCAR(697.2,MCARGNUM,0)),U,17)
- S ERROR=0,REC=MCREC,NCHANGE=0,(ORG,TEMP)=$G(^MCAR(MCFILE,REC,"ES")),EXIT=0,CODE=$P(TEMP,U,7),PROV=$$ESTONUM1^MCESSCR(CODE),$P(LINE,"_",80)="",MCESPED=TEMP,SUP="" K NEWST
- S LOOP=PROV
- I $P(TEMP,U,5)="" S XDUZ=1
- ;I CODE<3,($P(ORG,U,1)="") S $P(TEMP,U,1)=DUZ,$P(ORG,U,1)=DUZ
- I PROV<3,($P(ORG,U,1)="") S $P(TEMP,U,1)=DUZ,$P(ORG,U,1)=DUZ
- E S XDUZ=4
- S XDUZ=+$P(TEMP,U,XDUZ)
- I 'MCESSEC D EDD^MCESEDT2 S ^MCAR(MCFILE,MCARGDA,"ES")=TEMP Q
- S CREAT=$$GETDATE(15)
- I PROV<1!(PROV>7) S PROV=1
- I PROV=8 Q
- S Y=$P(^MCAR(MCFILE,REC,0),U,1) D DD^%DT
- S MDAT1=Y,MDAT2=$P($G(^MCAR(MCFILE,REC,0)),U,2),MDAT2=$P($G(^MCAR(690,+MDAT2,0)),U,1),MDAT2=$P($G(^DPT(+MDAT2,0)),U,1)
- S STATUS=$$STATUS(MCFILE,CODE)
- I PROV<3 S TDATE=$$GETDATE(3)
- E I PROV=3!(PROV=4)!(PROV=6)!(PROV=7) S TDATE=$$GETDATE(9)
- E I PROV=5 S TDATE=$$GETDATE(8)
- D HEADER
- I $P($G(^MCAR(MCFILE,REC,"ES")),U,7)="" D EDITD S ERROR=0 G SKIP
- I $D(MCBACK) D EDITSS K MCBACK G SKIP
- W !!!
- S DIR(0)="Y",DIR("A")=IOINHI_"Do you want to change the release status"_IOINORM,DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!(Y=0) W @IOF N DIE,DA,DR S DIE="^MCAR("_MCFILE_",",DA=REC,DR="1502///NOW" D ^DIE D EXIT Q
- SK ;
- D HEADER,@("EDIT"_$$NUMTOES^MCESSCR(PROV))
- SKIP ;
- I EXIT=0 S $P(TEMP,U,7)=SUP_$$NUMTOES^MCESSCR(LOOP) D:LOOP>2 HEADER
- D:EXIT=0 @("ED"_$$NUMTOES^MCESSCR(LOOP)_"^MCESEDT2")
- D UPDATE:EXIT=0,NOUPDATE:EXIT=1
- I '$D(DTOUT) S DIR(0)="E" D ^DIR K DIR
- EXIT ;
- D KILL^%ZISS W @IOF Q
- UPDATE ;
- W !!,"Record has been updated with new release information",!!
- S ORG=$P(ORG,U,7) K:ORG'="" ^MCAR(MCFILE,"ES",ORG,REC)
- S ^MCAR(MCFILE,REC,"ES")=TEMP,^MCAR(MCFILE,"ES",$P(TEMP,U,7),REC)=""
- N X S X="HMPEVNT" X ^%ZOSF("TEST") I $T S X=$P($G(^MCAR(MCFILE,REC,0)),U,2),X=$P($G(^MCAR(690,+X,0)),U,1) D CP^HMPEVNT(X,REC_";MCAR("_MCFILE_",") ;DE4487 CPC pass to HMP Freshness stream
- Q
- NOUPDATE ;
- W !!,"Record has not been updated with new release information",!!
- ;; ***ORIGINAL*** ;; S ^MCAR(MCFILE,REC,"ES")=ORG
- ; The 'IF $GET' was added to the set line to prevent dangling
- ; 'ES' nodes when the user supersedes a record, but up-arrows
- ; out of the edit and sign-off of the new record.
- I $G(^MCAR(MCFILE,REC,0))]"" S ^MCAR(MCFILE,REC,"ES")=ORG
- D DELSS ; NEW LINE
- Q
- EDITD ;Draft
- EDITPD ;Problem Draft
- S DIR("B")=PROV,DIR(0)="S^1:Draft;2:Problem Draft;3:Released On-Line Verified;4:Released Off-line Verified"
- S:RNV'=0 DIR(0)=DIR(0)_";5:Released not Verified"
- D ASK I EXIT=1,($P($G(^MCAR(MCFILE,REC,"ES")),U,7)="") S TY=1,EXIT=0
- Q:EXIT=1
- S LOOP=TY
- Q
- EDITSRV ;
- S SUP="S"
- EDITRV ;Released On-Line Verified
- S DIR("B")=1,DIR(0)="S^1:Released On-Line Verified;2:Supersede" D ASK Q:EXIT=1
- S:TY=2 SUP="" S LOOP=$S(TY=1:3,TY=2:8) Q
- EDITSROV ;
- S SUP="S"
- EDITROV ;Released Off-Line Verified
- S DIR("B")=2,DIR(0)="S^1:Released On-Line Verified;2:Released Off-Line Verified;3:Supersede" D ASK Q:EXIT=1
- S:TY=3 SUP="" S LOOP=$S(TY=1:3,TY=2:4,TY=3:8) Q
- EDITRNV ;Released Not Verified
- S DIR("B")=3,DIR(0)="S^1:Released On-Line Verified;2:Released Off-line Verified;3:Released not Verified;4:Supersede" D ASK Q:EXIT=1
- S LOOP=$S(TY=1:3,TY=2:4,TY=3:5,TY=4:8) Q
- EDITSS ;Superseded Change
- EDITS S SUP="S",DIR("B")=PROV,DIR(0)="S^1:Released On-Line Verified;2:Released Off-line Verified" D ASK
- I EXIT=1 D DELSS Q
- S LOOP=$S(TY=1:3,TY=2:4) Q
- DELSS ;
- Q:'$D(MCESPREV)
- W !!,"Since you did not sign the procedure results this report will be"
- W !,"deleted and the superseded report will be convert back the way it was."
- BACKSS ;
- S ^MCAR(MCFILE,MCESPREV,"ES")=MCESTEMP K ^MCAR(MCFILE,"ES","S",MCESPREV)
- S ^MCAR(MCFILE,"ES",$P(MCESTEMP,U,7),MCESPREV)="" S DIK="^MCAR("_MCFILE_",",DA=MCARGDA D ^DIK
- Q
- ASK ;Ask for a status code
- S DIR("A")=IOINHI_"Please Select a New Status"_IOINORM,DIR("?")="^D HELP^MCESHLP" D ^DIR S TY=Y I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S EXIT=1
- I Y=DIR("B"),(PROV>2) S EXIT=1,NCHANGE=1
- K DIR Q:EXIT=1
- S NEWST=Y(0) Q
- W @IOF,IODHLT," * * * Release Control * * *",!,IODHLB," * * * Release Control * * *"
- W !,LINE
- W:CREAT'[1700 !!,?4,IOINHI,"Created on: ",IOINORM,CREAT
- W !!,IOINHI,?14,"DATE: ",IOINORM,MDAT1,!,?16,MDAT2,!!,IOINHI,"Current Status: ",IOINORM,IOBON,STATUS,IOBOFF
- W:TDATE'="" IOINHI," as of ",IOINORM,TDATE
- S NAME=$$DECODE^MCESPRT(ORG,CODE,MCFILE,MCARGDA)
- W !,IOINHI,?16,"by: ",IOINORM,NAME
- I PROV=4 D PROVID
- I PROV=7!(PROV=8) S Y=$P(TEMP,U,14) D DD^%DT W !!,"This record supersedes record created on ",IOUON,Y,IOUOFF,"."
- W:$D(NEWST) !!,IOINHI,?8,"New status: ",IOINORM,NEWST
- W !,LINE Q
- PROVID ;
- W !,IOINHI,?15,"for: ",IOINORM
- S HDUZ=+$P(TEMP,U,4)
- I '$D(^VA(200,HDUZ,0)) W "unknown"
- E W $P(^VA(200,HDUZ,0),U,1)
- K HDUZ Q
- GETDATE(EE) ;
- N Y S Y=$P(TEMP,U,EE) D DD^%DT Q Y
- STATUS(FILE,PROV) ;
- N Y,C S Y=PROV,C=$P(^DD(FILE,1506,0),U,2) D Y^DIQ
- S:Y="" Y="DRAFT"
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESEDT 5383 printed Jan 18, 2025@03:16:16 Page 2
- MCESEDT ;WISC/DCB-ELECTRONIC SIGNATURE PART 1 ; 2/6/03 9:15am
- +1 ;;2.3;Medicine;**18,37,47**;09/13/1996;Build 12
- +2 ;
- +3 ;DE4487 - Call to HMP freshness stream
- POST(MCFILE,MCREC) ;Get the info about screen and set-up for edit.
- +1 if 'MCESON
- QUIT
- +2 DO ENS^%ZISS
- +3 NEW ERROR,HDUZ,HOLD,LOOP,MDAT1,MDAT2,NAME,REC,NEWREC,NEWST,ORG,PROV,RNV,SCRAMBLE,SREC,STATUS,TDATE,TEMP,TEMP1,TY,X1,XDUZ,NCHANGE,LINE,XDATE,DIE,DA,DR,CREAT,SUP,DJDN,CODE,CDUZ,EE,DTOUT,DUOUT,DIRUT,DIROUT
- +4 SET RNV=+$PIECE($GET(^MCAR(697.2,MCARGNUM,0)),U,17)
- +5 SET ERROR=0
- SET REC=MCREC
- SET NCHANGE=0
- SET (ORG,TEMP)=$GET(^MCAR(MCFILE,REC,"ES"))
- SET EXIT=0
- SET CODE=$PIECE(TEMP,U,7)
- SET PROV=$$ESTONUM1^MCESSCR(CODE)
- SET $PIECE(LINE,"_",80)=""
- SET MCESPED=TEMP
- SET SUP=""
- KILL NEWST
- +6 SET LOOP=PROV
- +7 IF $PIECE(TEMP,U,5)=""
- SET XDUZ=1
- +8 ;I CODE<3,($P(ORG,U,1)="") S $P(TEMP,U,1)=DUZ,$P(ORG,U,1)=DUZ
- +9 IF PROV<3
- IF ($PIECE(ORG,U,1)="")
- SET $PIECE(TEMP,U,1)=DUZ
- SET $PIECE(ORG,U,1)=DUZ
- +10 IF '$TEST
- SET XDUZ=4
- +11 SET XDUZ=+$PIECE(TEMP,U,XDUZ)
- +12 IF 'MCESSEC
- DO EDD^MCESEDT2
- SET ^MCAR(MCFILE,MCARGDA,"ES")=TEMP
- QUIT
- +13 SET CREAT=$$GETDATE(15)
- +14 IF PROV<1!(PROV>7)
- SET PROV=1
- +15 IF PROV=8
- QUIT
- +16 SET Y=$PIECE(^MCAR(MCFILE,REC,0),U,1)
- DO DD^%DT
- +17 SET MDAT1=Y
- SET MDAT2=$PIECE($GET(^MCAR(MCFILE,REC,0)),U,2)
- SET MDAT2=$PIECE($GET(^MCAR(690,+MDAT2,0)),U,1)
- SET MDAT2=$PIECE($GET(^DPT(+MDAT2,0)),U,1)
- +18 SET STATUS=$$STATUS(MCFILE,CODE)
- +19 IF PROV<3
- SET TDATE=$$GETDATE(3)
- +20 IF '$TEST
- IF PROV=3!(PROV=4)!(PROV=6)!(PROV=7)
- SET TDATE=$$GETDATE(9)
- +21 IF '$TEST
- IF PROV=5
- SET TDATE=$$GETDATE(8)
- +22 DO HEADER
- +23 IF $PIECE($GET(^MCAR(MCFILE,REC,"ES")),U,7)=""
- DO EDITD
- SET ERROR=0
- GOTO SKIP
- +24 IF $DATA(MCBACK)
- DO EDITSS
- KILL MCBACK
- GOTO SKIP
- +25 WRITE !!!
- +26 SET DIR(0)="Y"
- SET DIR("A")=IOINHI_"Do you want to change the release status"_IOINORM
- SET DIR("B")="N"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!(Y=0)
- WRITE @IOF
- NEW DIE,DA,DR
- SET DIE="^MCAR("_MCFILE_","
- SET DA=REC
- SET DR="1502///NOW"
- DO ^DIE
- DO EXIT
- QUIT
- SK ;
- +1 DO HEADER
- DO @("EDIT"_$$NUMTOES^MCESSCR(PROV))
- SKIP ;
- +1 IF EXIT=0
- SET $PIECE(TEMP,U,7)=SUP_$$NUMTOES^MCESSCR(LOOP)
- if LOOP>2
- DO HEADER
- +2 if EXIT=0
- DO @("ED"_$$NUMTOES^MCESSCR(LOOP)_"^MCESEDT2")
- +3 if EXIT=0
- DO UPDATE
- if EXIT=1
- DO NOUPDATE
- +4 IF '$DATA(DTOUT)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- EXIT ;
- +1 DO KILL^%ZISS
- WRITE @IOF
- QUIT
- UPDATE ;
- +1 WRITE !!,"Record has been updated with new release information",!!
- +2 SET ORG=$PIECE(ORG,U,7)
- if ORG'=""
- KILL ^MCAR(MCFILE,"ES",ORG,REC)
- +3 SET ^MCAR(MCFILE,REC,"ES")=TEMP
- SET ^MCAR(MCFILE,"ES",$PIECE(TEMP,U,7),REC)=""
- +4 ;DE4487 CPC pass to HMP Freshness stream
- NEW X
- SET X="HMPEVNT"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET X=$PIECE($GET(^MCAR(MCFILE,REC,0)),U,2)
- SET X=$PIECE($GET(^MCAR(690,+X,0)),U,1)
- DO CP^HMPEVNT(X,REC_";MCAR("_MCFILE_",")
- +5 QUIT
- NOUPDATE ;
- +1 WRITE !!,"Record has not been updated with new release information",!!
- +2 ;; ***ORIGINAL*** ;; S ^MCAR(MCFILE,REC,"ES")=ORG
- +3 ; The 'IF $GET' was added to the set line to prevent dangling
- +4 ; 'ES' nodes when the user supersedes a record, but up-arrows
- +5 ; out of the edit and sign-off of the new record.
- +6 IF $GET(^MCAR(MCFILE,REC,0))]""
- SET ^MCAR(MCFILE,REC,"ES")=ORG
- +7 ; NEW LINE
- DO DELSS
- +8 QUIT
- EDITD ;Draft
- EDITPD ;Problem Draft
- +1 SET DIR("B")=PROV
- SET DIR(0)="S^1:Draft;2:Problem Draft;3:Released On-Line Verified;4:Released Off-line Verified"
- +2 if RNV'=0
- SET DIR(0)=DIR(0)_";5:Released not Verified"
- +3 DO ASK
- IF EXIT=1
- IF ($PIECE($GET(^MCAR(MCFILE,REC,"ES")),U,7)="")
- SET TY=1
- SET EXIT=0
- +4 if EXIT=1
- QUIT
- +5 SET LOOP=TY
- +6 QUIT
- EDITSRV ;
- +1 SET SUP="S"
- EDITRV ;Released On-Line Verified
- +1 SET DIR("B")=1
- SET DIR(0)="S^1:Released On-Line Verified;2:Supersede"
- DO ASK
- if EXIT=1
- QUIT
- +2 if TY=2
- SET SUP=""
- SET LOOP=$SELECT(TY=1:3,TY=2:8)
- QUIT
- EDITSROV ;
- +1 SET SUP="S"
- EDITROV ;Released Off-Line Verified
- +1 SET DIR("B")=2
- SET DIR(0)="S^1:Released On-Line Verified;2:Released Off-Line Verified;3:Supersede"
- DO ASK
- if EXIT=1
- QUIT
- +2 if TY=3
- SET SUP=""
- SET LOOP=$SELECT(TY=1:3,TY=2:4,TY=3:8)
- QUIT
- EDITRNV ;Released Not Verified
- +1 SET DIR("B")=3
- SET DIR(0)="S^1:Released On-Line Verified;2:Released Off-line Verified;3:Released not Verified;4:Supersede"
- DO ASK
- if EXIT=1
- QUIT
- +2 SET LOOP=$SELECT(TY=1:3,TY=2:4,TY=3:5,TY=4:8)
- QUIT
- EDITSS ;Superseded Change
- EDITS SET SUP="S"
- SET DIR("B")=PROV
- SET DIR(0)="S^1:Released On-Line Verified;2:Released Off-line Verified"
- DO ASK
- +1 IF EXIT=1
- DO DELSS
- QUIT
- +2 SET LOOP=$SELECT(TY=1:3,TY=2:4)
- QUIT
- DELSS ;
- +1 if '$DATA(MCESPREV)
- QUIT
- +2 WRITE !!,"Since you did not sign the procedure results this report will be"
- +3 WRITE !,"deleted and the superseded report will be convert back the way it was."
- BACKSS ;
- +1 SET ^MCAR(MCFILE,MCESPREV,"ES")=MCESTEMP
- KILL ^MCAR(MCFILE,"ES","S",MCESPREV)
- +2 SET ^MCAR(MCFILE,"ES",$PIECE(MCESTEMP,U,7),MCESPREV)=""
- SET DIK="^MCAR("_MCFILE_","
- SET DA=MCARGDA
- DO ^DIK
- +3 QUIT
- ASK ;Ask for a status code
- +1 SET DIR("A")=IOINHI_"Please Select a New Status"_IOINORM
- SET DIR("?")="^D HELP^MCESHLP"
- DO ^DIR
- SET TY=Y
- IF $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
- SET EXIT=1
- +2 IF Y=DIR("B")
- IF (PROV>2)
- SET EXIT=1
- SET NCHANGE=1
- +3 KILL DIR
- if EXIT=1
- QUIT
- +4 SET NEWST=Y(0)
- QUIT
- +1 WRITE @IOF,IODHLT," * * * Release Control * * *",!,IODHLB," * * * Release Control * * *"
- +2 WRITE !,LINE
- +3 if CREAT'[1700
- WRITE !!,?4,IOINHI,"Created on: ",IOINORM,CREAT
- +4 WRITE !!,IOINHI,?14,"DATE: ",IOINORM,MDAT1,!,?16,MDAT2,!!,IOINHI,"Current Status: ",IOINORM,IOBON,STATUS,IOBOFF
- +5 if TDATE'=""
- WRITE IOINHI," as of ",IOINORM,TDATE
- +6 SET NAME=$$DECODE^MCESPRT(ORG,CODE,MCFILE,MCARGDA)
- +7 WRITE !,IOINHI,?16,"by: ",IOINORM,NAME
- +8 IF PROV=4
- DO PROVID
- +9 IF PROV=7!(PROV=8)
- SET Y=$PIECE(TEMP,U,14)
- DO DD^%DT
- WRITE !!,"This record supersedes record created on ",IOUON,Y,IOUOFF,"."
- +10 if $DATA(NEWST)
- WRITE !!,IOINHI,?8,"New status: ",IOINORM,NEWST
- +11 WRITE !,LINE
- QUIT
- PROVID ;
- +1 WRITE !,IOINHI,?15,"for: ",IOINORM
- +2 SET HDUZ=+$PIECE(TEMP,U,4)
- +3 IF '$DATA(^VA(200,HDUZ,0))
- WRITE "unknown"
- +4 IF '$TEST
- WRITE $PIECE(^VA(200,HDUZ,0),U,1)
- +5 KILL HDUZ
- QUIT
- GETDATE(EE) ;
- +1 NEW Y
- SET Y=$PIECE(TEMP,U,EE)
- DO DD^%DT
- QUIT Y
- STATUS(FILE,PROV) ;
- +1 NEW Y,C
- SET Y=PROV
- SET C=$PIECE(^DD(FILE,1506,0),U,2)
- DO Y^DIQ
- +2 if Y=""
- SET Y="DRAFT"
- +3 QUIT Y