- MCESCONV ;WISC/DCB-Convert PFTs to Electronic Signature ;7/31/96 15:32
- ;;2.3;Medicine;**8**;09/13/1996
- CONV ;
- N MCARGDA,MCREL,PDUZ,DRAFT,RELEASE,LOOP,LOCATION,CHECK,CODE2,INFO2
- N SDRAFT,SRELEASE,MCOUNT,XMY,XMSUB,XMDUZ,XMTEXT,REC,PROC,MCARCK
- N STATUS2,MCUTOFDT
- D MCEPROC^MCARE
- S:MCESKEY="MCGIKEY" MCROUT="GI"
- S:$D(^XUSEC(MCESKEY,DUZ)) MCESSEC=1
- S MCNODE=$S(MCFILE=700:2,MCFILE=694:0,1:"")
- S MCPIECE=$S(MCFILE=700:1,MCFILE=694:9,1:"")
- ; for PFT, check if version not 2.2
- I MCFILE=700 D
- .S REC=+$O(^DIC(9.4,"B","MEDICINE",""))
- .S CHECK=+$O(^DIC(9.4,REC,22,"B","2.2",""))
- .I CHECK="" S (MCNODE,MCPIECE)=""
- S:MCFILE=699 MCARCODE=$S(MCESKEY="MCGIKEY":"G",1:"P")
- I '$D(MCESSEC) W !,"You do not have '"_MCESKEY_"' KEY for "_MCROUT_"." D EXIT Q
- I '$D(^XUSEC("MCMANAGER",DUZ)) W !,"You do not have the Manager key" D EXIT Q
- ;W !,"This is a one time execution menu option."
- N DIR S DIR(0)="DAO^:"_DT_":AEX"
- S DIR("A")="Convert all records prior to: "
- S DIR("?")="Enter an exact date less than or equal to today."
- S DIR("?",1)="All records on or prior to this date will be converted."
- S DIR("?",2)="Any records after this date will be left as is."
- W ! D ^DIR S MCUTOFDT=+Y Q:$D(DIRUT)
- W ! D NOW^%DTC
- S LOC="Undefined",MCARGDA=.9,MCOUNT=8,SDRAFT=0,SRELEASE=0,NOW=$E(%,1,12),PDUZ=$$PERSON(MCESKEY),REC="",REC=$O(^DIC(4,"D",DUZ(2),REC))
- S:REC'="" LOC=$P($G(^DIC(4,REC,0)),U,1)
- Q:PDUZ=-1
- S ^TMP("MCAR",$J,1)=Y(0,0)_" has been"
- S ^TMP("MCAR",$J,2)="assigned the responsibility for releasing"
- S ^TMP("MCAR",$J,3)="the procedure results that were released not verified"
- S ^TMP("MCAR",$J,4)="for the "_MCROUT_" procedure file."
- S ^TMP("MCAR",$J,5)="Only procedures on or prior to "_$$FMTE^XLFDT(MCUTOFDT)_" have been updated."
- S ^TMP("MCAR",$J,6)=""
- S ^TMP("MCAR",$J,7)="The following is a list of records that has been assigned a status:"
- S ^TMP("MCAR",$J,8)=""
- W !!,"Your records are being converted. Please wait!"
- W !,"A mail message will be sent to you with records that are converted."
- W !,"A dot is equal to 5 records."
- F LOOP=1:1 D START Q:MCARGDA=""
- S ^TMP("MCAR",$J,MCOUNT)="",MCOUNT=MCOUNT+1
- I SDRAFT>0 S ^TMP("MCAR",$J,MCOUNT)="Records that have been assigned a draft status: "_SDRAFT,MCOUNT=MCOUNT+1
- I SRELEASE>0 S ^TMP("MCAR",$J,MCOUNT)="Records that have been assigned a released not verified: "_SRELEASE
- S XMSUB="Procedure File Change",XMDUZ="<Installer of Medicine>",XMTEXT="^TMP(""MCAR"","_$J_","
- S:PDUZ'=DUZ XMY(PDUZ)=""
- S XMY(DUZ)=""
- D ^XMD
- K ^TMP("MCAR",$J)
- Q
- ESTOON ; Turn ES to ON.
- S:'$D(MCPRO) MCPRO=$E($P(XQY0,U),8,$L($P(XQY0,U)))
- D MCPPROC^MCARP
- I MCESON W !,"Electronic Signature is already on!"
- I '$D(^XUSEC(MCESKEY,DUZ)) W !,"You do not have '"_MCESKEY_"' KEY for "_MCROUT_"." D EXIT Q
- I '$D(^XUSEC("MCMANAGER",DUZ)) W !,"You do not have the Manager key" D EXIT Q
- S TYPE=$P(^MCAR(697.2,MCARP,0),U,4)
- I TYPE="GEN" D SETESON("GEN",14)
- I TYPE="I"!(TYPE="G") D SETESON("G",14),SETESON("I",14)
- I TYPE="P" D SETESON("P",14)
- I TYPE="HI"!(TYPE="H") D SETESON("H",14),SETESON("HI",14)
- S $P(^MCAR(697.2,MCARP,0),U,14)=1
- I 'MCESON W !,"Electronic Signature is now turned on!"
- D EXIT
- Q
- SETESON(PROC,PIECE) ; Set ES ON ALL PULM AND GI PROC
- N ORDER S ORDER=""
- F S ORDER=$O(^MCAR(697.2,"D",PROC,ORDER)) Q:ORDER="" D
- .S $P(^MCAR(697.2,ORDER,0),U,PIECE)=1
- Q
- START ;
- S MCARGDA=$O(^MCAR(MCFILE,MCARGDA))
- S:+MCARGDA=0 MCARGDA="" Q:MCARGDA=""
- N Y S Y=$P($G(^MCAR(MCFILE,MCARGDA,0)),U)\1 I (Y'>0)!(Y>MCUTOFDT) Q
- I MCFILE=691.5,'$D(^MCAR(MCFILE,MCARGDA,"ES")) Q
- Q:$P($G(^MCAR(MCFILE,MCARGDA,"ES")),U,7)'=""
- S DRAFT=PDUZ_"^^"_NOW_"^^^^D^"_NOW_"^^^^^^^"_$P(^MCAR(MCFILE,MCARGDA,0),U,1)
- S RELEASE=PDUZ_"^^"_NOW_"^^^^RNV^"_NOW_"^^^^^^^"_$P(^MCAR(MCFILE,MCARGDA,0),U,1)
- S:MCNODE'="" MCREL=$P($G(^MCAR(MCFILE,MCARGDA,MCNODE)),U,MCPIECE)
- I MCFILE=699 S MCARCK=+$P(^MCAR(699,MCARGDA,0),U,12) I MCARCK=0,$D(^MCAR(697.2,"D",MCARCODE,MCARCK)) Q
- I MCFILE=699.5,('$P(^MCAR(699.5,MCARGDA,0),U,3)),($P(^MCAR(699.5,MCARGDA,0),U,6)=MCARP) Q
- D STATUS
- S ^MCAR(MCFILE,MCARGDA,"ES")=STATUS
- S ^MCAR(MCFILE,"ES",STATUS2,MCARGDA)=""
- I (LOOP\5)=(LOOP/5) W "."
- Q
- PERSON(MCESKEY) ; Get a person with the right key.
- W !,"In order to do the conversion, you must select a provider that"
- W !,"has the key to ",MCROUT,!!!!
- S DIC=200,DIC(0)="AEQMZ",DIC("A")="Please select a Provider with a "_MCROUT_" key: ",DIC("S")="I $D(^XUSEC(MCESKEY,Y))"
- S:$D(^XUSEC(MCESKEY,DUZ)) DIC("B")=DUZ
- D ^DIC K DIC
- Q +Y
- STATUS ; Current status of the record
- S Y=$P($G(^MCAR(MCFILE,MCARGDA,0)),U,1) D DD^%DT
- S:MCNODE="" MCREL="Y"
- I MCREL="Y" D
- .S SRELEASE=SRELEASE+1,STATUS=RELEASE,STATUS2="RNV"
- .S ^TMP("MCAR",$J,MCOUNT)=$J(MCARGDA,10,0)_" "_$J(Y,20)_" -Released Not Verfied"
- E D
- .S SDRAFT=SDRAFT+1,STATUS=DRAFT,STATUS2="D"
- .S ^TMP("MCAR",$J,MCOUNT)=$J(MCARGDA,10,0)_" "_$J(Y,20)_" -Draft"
- S MCOUNT=MCOUNT+1
- Q
- EXIT ;
- K MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
- K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE
- K MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESCONV 5142 printed Feb 18, 2025@23:41:31 Page 2
- MCESCONV ;WISC/DCB-Convert PFTs to Electronic Signature ;7/31/96 15:32
- +1 ;;2.3;Medicine;**8**;09/13/1996
- CONV ;
- +1 NEW MCARGDA,MCREL,PDUZ,DRAFT,RELEASE,LOOP,LOCATION,CHECK,CODE2,INFO2
- +2 NEW SDRAFT,SRELEASE,MCOUNT,XMY,XMSUB,XMDUZ,XMTEXT,REC,PROC,MCARCK
- +3 NEW STATUS2,MCUTOFDT
- +4 DO MCEPROC^MCARE
- +5 if MCESKEY="MCGIKEY"
- SET MCROUT="GI"
- +6 if $DATA(^XUSEC(MCESKEY,DUZ))
- SET MCESSEC=1
- +7 SET MCNODE=$SELECT(MCFILE=700:2,MCFILE=694:0,1:"")
- +8 SET MCPIECE=$SELECT(MCFILE=700:1,MCFILE=694:9,1:"")
- +9 ; for PFT, check if version not 2.2
- +10 IF MCFILE=700
- Begin DoDot:1
- +11 SET REC=+$ORDER(^DIC(9.4,"B","MEDICINE",""))
- +12 SET CHECK=+$ORDER(^DIC(9.4,REC,22,"B","2.2",""))
- +13 IF CHECK=""
- SET (MCNODE,MCPIECE)=""
- End DoDot:1
- +14 if MCFILE=699
- SET MCARCODE=$SELECT(MCESKEY="MCGIKEY":"G",1:"P")
- +15 IF '$DATA(MCESSEC)
- WRITE !,"You do not have '"_MCESKEY_"' KEY for "_MCROUT_"."
- DO EXIT
- QUIT
- +16 IF '$DATA(^XUSEC("MCMANAGER",DUZ))
- WRITE !,"You do not have the Manager key"
- DO EXIT
- QUIT
- +17 ;W !,"This is a one time execution menu option."
- +18 NEW DIR
- SET DIR(0)="DAO^:"_DT_":AEX"
- +19 SET DIR("A")="Convert all records prior to: "
- +20 SET DIR("?")="Enter an exact date less than or equal to today."
- +21 SET DIR("?",1)="All records on or prior to this date will be converted."
- +22 SET DIR("?",2)="Any records after this date will be left as is."
- +23 WRITE !
- DO ^DIR
- SET MCUTOFDT=+Y
- if $DATA(DIRUT)
- QUIT
- +24 WRITE !
- DO NOW^%DTC
- +25 SET LOC="Undefined"
- SET MCARGDA=.9
- SET MCOUNT=8
- SET SDRAFT=0
- SET SRELEASE=0
- SET NOW=$EXTRACT(%,1,12)
- SET PDUZ=$$PERSON(MCESKEY)
- SET REC=""
- SET REC=$ORDER(^DIC(4,"D",DUZ(2),REC))
- +26 if REC'=""
- SET LOC=$PIECE($GET(^DIC(4,REC,0)),U,1)
- +27 if PDUZ=-1
- QUIT
- +28 SET ^TMP("MCAR",$JOB,1)=Y(0,0)_" has been"
- +29 SET ^TMP("MCAR",$JOB,2)="assigned the responsibility for releasing"
- +30 SET ^TMP("MCAR",$JOB,3)="the procedure results that were released not verified"
- +31 SET ^TMP("MCAR",$JOB,4)="for the "_MCROUT_" procedure file."
- +32 SET ^TMP("MCAR",$JOB,5)="Only procedures on or prior to "_$$FMTE^XLFDT(MCUTOFDT)_" have been updated."
- +33 SET ^TMP("MCAR",$JOB,6)=""
- +34 SET ^TMP("MCAR",$JOB,7)="The following is a list of records that has been assigned a status:"
- +35 SET ^TMP("MCAR",$JOB,8)=""
- +36 WRITE !!,"Your records are being converted. Please wait!"
- +37 WRITE !,"A mail message will be sent to you with records that are converted."
- +38 WRITE !,"A dot is equal to 5 records."
- +39 FOR LOOP=1:1
- DO START
- if MCARGDA=""
- QUIT
- +40 SET ^TMP("MCAR",$JOB,MCOUNT)=""
- SET MCOUNT=MCOUNT+1
- +41 IF SDRAFT>0
- SET ^TMP("MCAR",$JOB,MCOUNT)="Records that have been assigned a draft status: "_SDRAFT
- SET MCOUNT=MCOUNT+1
- +42 IF SRELEASE>0
- SET ^TMP("MCAR",$JOB,MCOUNT)="Records that have been assigned a released not verified: "_SRELEASE
- +43 SET XMSUB="Procedure File Change"
- SET XMDUZ="<Installer of Medicine>"
- SET XMTEXT="^TMP(""MCAR"","_$JOB_","
- +44 if PDUZ'=DUZ
- SET XMY(PDUZ)=""
- +45 SET XMY(DUZ)=""
- +46 DO ^XMD
- +47 KILL ^TMP("MCAR",$JOB)
- +48 QUIT
- ESTOON ; Turn ES to ON.
- +1 if '$DATA(MCPRO)
- SET MCPRO=$EXTRACT($PIECE(XQY0,U),8,$LENGTH($PIECE(XQY0,U)))
- +2 DO MCPPROC^MCARP
- +3 IF MCESON
- WRITE !,"Electronic Signature is already on!"
- +4 IF '$DATA(^XUSEC(MCESKEY,DUZ))
- WRITE !,"You do not have '"_MCESKEY_"' KEY for "_MCROUT_"."
- DO EXIT
- QUIT
- +5 IF '$DATA(^XUSEC("MCMANAGER",DUZ))
- WRITE !,"You do not have the Manager key"
- DO EXIT
- QUIT
- +6 SET TYPE=$PIECE(^MCAR(697.2,MCARP,0),U,4)
- +7 IF TYPE="GEN"
- DO SETESON("GEN",14)
- +8 IF TYPE="I"!(TYPE="G")
- DO SETESON("G",14)
- DO SETESON("I",14)
- +9 IF TYPE="P"
- DO SETESON("P",14)
- +10 IF TYPE="HI"!(TYPE="H")
- DO SETESON("H",14)
- DO SETESON("HI",14)
- +11 SET $PIECE(^MCAR(697.2,MCARP,0),U,14)=1
- +12 IF 'MCESON
- WRITE !,"Electronic Signature is now turned on!"
- +13 DO EXIT
- +14 QUIT
- SETESON(PROC,PIECE) ; Set ES ON ALL PULM AND GI PROC
- +1 NEW ORDER
- SET ORDER=""
- +2 FOR
- SET ORDER=$ORDER(^MCAR(697.2,"D",PROC,ORDER))
- if ORDER=""
- QUIT
- Begin DoDot:1
- +3 SET $PIECE(^MCAR(697.2,ORDER,0),U,PIECE)=1
- End DoDot:1
- +4 QUIT
- START ;
- +1 SET MCARGDA=$ORDER(^MCAR(MCFILE,MCARGDA))
- +2 if +MCARGDA=0
- SET MCARGDA=""
- if MCARGDA=""
- QUIT
- +3 NEW Y
- SET Y=$PIECE($GET(^MCAR(MCFILE,MCARGDA,0)),U)\1
- IF (Y'>0)!(Y>MCUTOFDT)
- QUIT
- +4 IF MCFILE=691.5
- IF '$DATA(^MCAR(MCFILE,MCARGDA,"ES"))
- QUIT
- +5 if $PIECE($GET(^MCAR(MCFILE,MCARGDA,"ES")),U,7)'=""
- QUIT
- +6 SET DRAFT=PDUZ_"^^"_NOW_"^^^^D^"_NOW_"^^^^^^^"_$PIECE(^MCAR(MCFILE,MCARGDA,0),U,1)
- +7 SET RELEASE=PDUZ_"^^"_NOW_"^^^^RNV^"_NOW_"^^^^^^^"_$PIECE(^MCAR(MCFILE,MCARGDA,0),U,1)
- +8 if MCNODE'=""
- SET MCREL=$PIECE($GET(^MCAR(MCFILE,MCARGDA,MCNODE)),U,MCPIECE)
- +9 IF MCFILE=699
- SET MCARCK=+$PIECE(^MCAR(699,MCARGDA,0),U,12)
- IF MCARCK=0
- IF $DATA(^MCAR(697.2,"D",MCARCODE,MCARCK))
- QUIT
- +10 IF MCFILE=699.5
- IF ('$PIECE(^MCAR(699.5,MCARGDA,0),U,3))
- IF ($PIECE(^MCAR(699.5,MCARGDA,0),U,6)=MCARP)
- QUIT
- +11 DO STATUS
- +12 SET ^MCAR(MCFILE,MCARGDA,"ES")=STATUS
- +13 SET ^MCAR(MCFILE,"ES",STATUS2,MCARGDA)=""
- +14 IF (LOOP\5)=(LOOP/5)
- WRITE "."
- +15 QUIT
- PERSON(MCESKEY) ; Get a person with the right key.
- +1 WRITE !,"In order to do the conversion, you must select a provider that"
- +2 WRITE !,"has the key to ",MCROUT,!!!!
- +3 SET DIC=200
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Please select a Provider with a "_MCROUT_" key: "
- SET DIC("S")="I $D(^XUSEC(MCESKEY,Y))"
- +4 if $DATA(^XUSEC(MCESKEY,DUZ))
- SET DIC("B")=DUZ
- +5 DO ^DIC
- KILL DIC
- +6 QUIT +Y
- STATUS ; Current status of the record
- +1 SET Y=$PIECE($GET(^MCAR(MCFILE,MCARGDA,0)),U,1)
- DO DD^%DT
- +2 if MCNODE=""
- SET MCREL="Y"
- +3 IF MCREL="Y"
- Begin DoDot:1
- +4 SET SRELEASE=SRELEASE+1
- SET STATUS=RELEASE
- SET STATUS2="RNV"
- +5 SET ^TMP("MCAR",$JOB,MCOUNT)=$JUSTIFY(MCARGDA,10,0)_" "_$JUSTIFY(Y,20)_" -Released Not Verfied"
- End DoDot:1
- +6 IF '$TEST
- Begin DoDot:1
- +7 SET SDRAFT=SDRAFT+1
- SET STATUS=DRAFT
- SET STATUS2="D"
- +8 SET ^TMP("MCAR",$JOB,MCOUNT)=$JUSTIFY(MCARGDA,10,0)_" "_$JUSTIFY(Y,20)_" -Draft"
- End DoDot:1
- +9 SET MCOUNT=MCOUNT+1
- +10 QUIT
- EXIT ;
- +1 KILL MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
- +2 KILL MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE
- +3 KILL MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS
- +4 QUIT