Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCESEDT

MCESEDT.m

Go to the documentation of this file.
  1. MCESEDT ;WISC/DCB-ELECTRONIC SIGNATURE PART 1 ; 2/6/03 9:15am
  1. ;;2.3;Medicine;**18,37,47**;09/13/1996;Build 12
  1. ;
  1. ;DE4487 - Call to HMP freshness stream
  1. POST(MCFILE,MCREC) ;Get the info about screen and set-up for edit.
  1. Q:'MCESON
  1. D ENS^%ZISS
  1. 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
  1. S RNV=+$P($G(^MCAR(697.2,MCARGNUM,0)),U,17)
  1. 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
  1. S LOOP=PROV
  1. I $P(TEMP,U,5)="" S XDUZ=1
  1. ;I CODE<3,($P(ORG,U,1)="") S $P(TEMP,U,1)=DUZ,$P(ORG,U,1)=DUZ
  1. I PROV<3,($P(ORG,U,1)="") S $P(TEMP,U,1)=DUZ,$P(ORG,U,1)=DUZ
  1. E S XDUZ=4
  1. S XDUZ=+$P(TEMP,U,XDUZ)
  1. I 'MCESSEC D EDD^MCESEDT2 S ^MCAR(MCFILE,MCARGDA,"ES")=TEMP Q
  1. S CREAT=$$GETDATE(15)
  1. I PROV<1!(PROV>7) S PROV=1
  1. I PROV=8 Q
  1. S Y=$P(^MCAR(MCFILE,REC,0),U,1) D DD^%DT
  1. 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)
  1. S STATUS=$$STATUS(MCFILE,CODE)
  1. I PROV<3 S TDATE=$$GETDATE(3)
  1. E I PROV=3!(PROV=4)!(PROV=6)!(PROV=7) S TDATE=$$GETDATE(9)
  1. E I PROV=5 S TDATE=$$GETDATE(8)
  1. D HEADER
  1. I $P($G(^MCAR(MCFILE,REC,"ES")),U,7)="" D EDITD S ERROR=0 G SKIP
  1. I $D(MCBACK) D EDITSS K MCBACK G SKIP
  1. W !!!
  1. 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
  1. SK ;
  1. D HEADER,@("EDIT"_$$NUMTOES^MCESSCR(PROV))
  1. SKIP ;
  1. I EXIT=0 S $P(TEMP,U,7)=SUP_$$NUMTOES^MCESSCR(LOOP) D:LOOP>2 HEADER
  1. D:EXIT=0 @("ED"_$$NUMTOES^MCESSCR(LOOP)_"^MCESEDT2")
  1. D UPDATE:EXIT=0,NOUPDATE:EXIT=1
  1. I '$D(DTOUT) S DIR(0)="E" D ^DIR K DIR
  1. EXIT ;
  1. D KILL^%ZISS W @IOF Q
  1. UPDATE ;
  1. W !!,"Record has been updated with new release information",!!
  1. S ORG=$P(ORG,U,7) K:ORG'="" ^MCAR(MCFILE,"ES",ORG,REC)
  1. S ^MCAR(MCFILE,REC,"ES")=TEMP,^MCAR(MCFILE,"ES",$P(TEMP,U,7),REC)=""
  1. 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
  1. Q
  1. NOUPDATE ;
  1. W !!,"Record has not been updated with new release information",!!
  1. ;; ***ORIGINAL*** ;; S ^MCAR(MCFILE,REC,"ES")=ORG
  1. ; The 'IF $GET' was added to the set line to prevent dangling
  1. ; 'ES' nodes when the user supersedes a record, but up-arrows
  1. ; out of the edit and sign-off of the new record.
  1. I $G(^MCAR(MCFILE,REC,0))]"" S ^MCAR(MCFILE,REC,"ES")=ORG
  1. D DELSS ; NEW LINE
  1. Q
  1. EDITD ;Draft
  1. EDITPD ;Problem Draft
  1. S DIR("B")=PROV,DIR(0)="S^1:Draft;2:Problem Draft;3:Released On-Line Verified;4:Released Off-line Verified"
  1. S:RNV'=0 DIR(0)=DIR(0)_";5:Released not Verified"
  1. D ASK I EXIT=1,($P($G(^MCAR(MCFILE,REC,"ES")),U,7)="") S TY=1,EXIT=0
  1. Q:EXIT=1
  1. S LOOP=TY
  1. Q
  1. EDITSRV ;
  1. S SUP="S"
  1. EDITRV ;Released On-Line Verified
  1. S DIR("B")=1,DIR(0)="S^1:Released On-Line Verified;2:Supersede" D ASK Q:EXIT=1
  1. S:TY=2 SUP="" S LOOP=$S(TY=1:3,TY=2:8) Q
  1. EDITSROV ;
  1. S SUP="S"
  1. EDITROV ;Released Off-Line Verified
  1. S DIR("B")=2,DIR(0)="S^1:Released On-Line Verified;2:Released Off-Line Verified;3:Supersede" D ASK Q:EXIT=1
  1. S:TY=3 SUP="" S LOOP=$S(TY=1:3,TY=2:4,TY=3:8) Q
  1. EDITRNV ;Released Not Verified
  1. 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
  1. S LOOP=$S(TY=1:3,TY=2:4,TY=3:5,TY=4:8) Q
  1. EDITSS ;Superseded Change
  1. EDITS S SUP="S",DIR("B")=PROV,DIR(0)="S^1:Released On-Line Verified;2:Released Off-line Verified" D ASK
  1. I EXIT=1 D DELSS Q
  1. S LOOP=$S(TY=1:3,TY=2:4) Q
  1. DELSS ;
  1. Q:'$D(MCESPREV)
  1. W !!,"Since you did not sign the procedure results this report will be"
  1. W !,"deleted and the superseded report will be convert back the way it was."
  1. BACKSS ;
  1. S ^MCAR(MCFILE,MCESPREV,"ES")=MCESTEMP K ^MCAR(MCFILE,"ES","S",MCESPREV)
  1. S ^MCAR(MCFILE,"ES",$P(MCESTEMP,U,7),MCESPREV)="" S DIK="^MCAR("_MCFILE_",",DA=MCARGDA D ^DIK
  1. Q
  1. ASK ;Ask for a status code
  1. 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
  1. I Y=DIR("B"),(PROV>2) S EXIT=1,NCHANGE=1
  1. K DIR Q:EXIT=1
  1. S NEWST=Y(0) Q
  1. W @IOF,IODHLT," * * * Release Control * * *",!,IODHLB," * * * Release Control * * *"
  1. W !,LINE
  1. W:CREAT'[1700 !!,?4,IOINHI,"Created on: ",IOINORM,CREAT
  1. W !!,IOINHI,?14,"DATE: ",IOINORM,MDAT1,!,?16,MDAT2,!!,IOINHI,"Current Status: ",IOINORM,IOBON,STATUS,IOBOFF
  1. W:TDATE'="" IOINHI," as of ",IOINORM,TDATE
  1. S NAME=$$DECODE^MCESPRT(ORG,CODE,MCFILE,MCARGDA)
  1. W !,IOINHI,?16,"by: ",IOINORM,NAME
  1. I PROV=4 D PROVID
  1. I PROV=7!(PROV=8) S Y=$P(TEMP,U,14) D DD^%DT W !!,"This record supersedes record created on ",IOUON,Y,IOUOFF,"."
  1. W:$D(NEWST) !!,IOINHI,?8,"New status: ",IOINORM,NEWST
  1. W !,LINE Q
  1. PROVID ;
  1. W !,IOINHI,?15,"for: ",IOINORM
  1. S HDUZ=+$P(TEMP,U,4)
  1. I '$D(^VA(200,HDUZ,0)) W "unknown"
  1. E W $P(^VA(200,HDUZ,0),U,1)
  1. K HDUZ Q
  1. GETDATE(EE) ;
  1. N Y S Y=$P(TEMP,U,EE) D DD^%DT Q Y
  1. STATUS(FILE,PROV) ;
  1. N Y,C S Y=PROV,C=$P(^DD(FILE,1506,0),U,2) D Y^DIQ
  1. S:Y="" Y="DRAFT"
  1. Q Y