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

TIUPSCS.m

Go to the documentation of this file. 
  1. TIUPSCS ;BPOIFO/EL/CR - TIU DOCUMENT POST-SIGNATURE ALERT SETUP ;10/29/17 8:15am
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
  1.  ;
  1.  ; External Reference DBIA#:
  1.  ; -------------------------
  1.  ; #2056  - $$GET1^DIQ call (Supported)
  1.  ; #6811  - Reference to file #100.21 (Private)
  1.  ; #10006 - DIC call (Supported)
  1.  ; #10026 - DIR call (Supported) 
  1.  ; #10060 - Reference to file 200 (Supported)
  1.  ; #10111 - Reference to file 3.8 (Supported)
  1.  Q
  1.  ;
  1. BUILD ;
  1.  ; allow a CAC to setup the title for post-signature alerts - a controlled situation
  1.  S ^TIU(8925.1,TIUIEN,4.9)=TIUDR
  1.  W !!,"The Post-Signature code for '"_$$GET1^DIQ(TIUFLE,TIUIEN,.01)_"' has been updated as follows..."
  1.  W !,"POST-SIGNATURE CODE: "_$$GET1^DIQ(TIUFLE,TIUIEN,4.9)
  1.  Q
  1.  ;
  1. CONFIRM ;
  1.  S (TIUDR,Y)=""
  1.  I TIUXQA=+TIUXQA S TIUDR="D EN^TIUPSCA("_TIUXQA_","""_$G(TIUSPEC)_""","""_$G(TIUDEV)_""")"
  1.  E  S TIUDR="D EN^TIUPSCA("""_TIUXQA_""","""_$G(TIUSPEC)_""","""_$G(TIUDEV)_""")"
  1.  W !!,"The Post-Signature code for '"_TIUNAME_"' will be set as follows..."
  1.  W !,"POST-SIGNATURE CODE: "_TIUDR,!
  1.  S DIR("T")=TIUWAIT
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to update Post-Signature Code into '"_TIUNAME_"'"
  1.  S DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT)!'$G(Y) D  S TIUGO=0 Q
  1.  . W !!,"No action has been taken!!"
  1.  Q
  1.  ;
  1. DEL ; use to clean up an existing setup
  1.  S DIR("T")=TIUWAIT
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to delete Post-Signature Code from '"_TIUNAME_"'"
  1.  S DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT)!'$G(Y) D  S TIUGO=0 Q
  1.  . W !!,"No action has been taken!!"
  1.  ; allow a CAC to delete a setup when needed - a controlled situation
  1.  S ^TIU(8925.1,TIUIEN,4.9)=""
  1.  W !,"... Deleted ..."
  1.  H 1
  1.  Q
  1.  ;
  1. DEVICE ;
  1.  W !
  1.  S (TIUDEV,Y)=""
  1.  S DIC=3.5,DIC(0)="AEMQ",DIC("A")="DEVICE NAME (Optional) for Paper Alert: "
  1.  D ^DIC K DIC
  1.  I $D(DUOUT)!$D(DTOUT) D  S TIUGO=0 G DEVQ
  1.  . W !!,"ABORT DEVICE - No action is taken."
  1.  I $G(Y)>0 S TIUDEV=$P(Y,U,2)
  1. DEVQ ;
  1.  Q
  1.  ;
  1. EN ; entry point for the option [TIUFPC CREATE POST-SIGNATURE] 
  1.  N DA,DIROUT,DIRUT,DR,DTOUT,DUOUT
  1.  N H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUFLE,TIUGO,TIUIE,TIUIEN
  1.  N TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWAIT,TIUWHO,TIUXQA
  1.  N X,Y,Z,Z1,Z2,ZZ,ZZIEN
  1.  ;
  1.  S TIUWAIT=30
  1.  I $G(DTIME)'="" S TIUWAIT=DTIME
  1.  S TIUFLE=8925.1
  1.  S STOP=0,TIUGO=1
  1.  I '$D(U) S U="^"
  1.  ;
  1. EN10 ;
  1.  I $G(STOP)=1 Q
  1.  D INTRO
  1.  W ! D GETTITLE Q:$G(STOP)=1  I $G(TIUGO)=0 D STOP G EN10
  1.  W ! D WHO I $G(TIUGO)=0 D STOP G EN10
  1.  W ! D SUBROUT I $G(TIUGO)=0 D STOP G EN10
  1.  W ! D DEVICE I $G(TIUGO)=0 D STOP G EN10
  1.  W ! D CONFIRM I $G(TIUGO)=0 D STOP G EN10
  1.  W ! D BUILD D STOP
  1.  G EN10
  1.  ;
  1. GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE) ; Get field value
  1.  K ZZ S (Z,ZZIEN)=""
  1.  S ZZIEN=TIUIEN_","
  1.  D GETS^DIQ(TIUFLE,ZZIEN,TIUFLD,TIUIE,"ZZ")
  1.  S Z=$G(ZZ(TIUFLE,ZZIEN,TIUFLD,TIUIE))
  1.  Q $G(Z)
  1.  ;
  1. GETTITLE ;
  1.  S (TIUIEN,TIUNAME,Y)=""
  1.  S TIUGO=1
  1.  S DIC=TIUFLE,DIC(0)="AEMQ"
  1.  D ^DIC K DIC
  1.  I $G(Y)'>0!$D(DTOUT)!$D(DUOUT) S TIUGO=0,STOP=1 Q
  1.  S TIUIEN=+$G(Y),TIUNAME=$P(Y,U,2)
  1.  ; lock the title to be updated, the lock is released at the end the setup at tag STOP
  1.  L +^TIU(TIUFLE,TIUIEN):1 E  W !!,"Someone else is editing this record, try again later.",! S STOP=1 Q 
  1.  ; Check Class
  1.  S (TIUFLD,TIUIE,Z)=""
  1.  S TIUGO=1
  1.  S TIUFLD=.13,TIUIE="I"
  1.  S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
  1.  I +$G(Z)>0 D  S TIUGO=0 Q
  1.  . W !!,"NATIONAL STANDARD Document Type cannot be edited."
  1.  S TIUFLD=.04,TIUIE="I"
  1.  S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
  1.  I $G(Z)'="DOC" D  S TIUGO=0 Q
  1.  . W !!,"Only Document Title is allowed to be edited."
  1.  ;
  1.  ; Check Inherit
  1.  S (TIUPREV)=""
  1.  S TIUGO=1
  1.  S TIUPREV=$$POSTSIGN^TIULC1(TIUIEN)
  1.  I $G(TIUPREV)="" G STATUS
  1.  ; once the title has been set up for the post-sig alert, get the closing ')'
  1.  ; at the end of the parameters list
  1.  I $E(TIUPREV,$L(TIUPREV))'=")" D  S TIUGO=0 Q
  1.  .  W !!,"This application cannot alter more than one alert call at a time."
  1.  .  W !,"It is --> ",TIUPREV
  1.  I $P(TIUPREV,"(")="D EN^TIUPSCA" D  G STATUS
  1.  .  W !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was created by this option."
  1.  .  W !,"It is --> ",TIUPREV
  1.  .  S DIR("A")="Do you want to change the Code? (YES or NO)"
  1.  .  S DIR("T")=TIUWAIT
  1.  .  S DIR(0)="Y"
  1.  .  S DIR("B")="NO"
  1.  .  W ! D ^DIR K DIR
  1.  .  I $D(DIRUT)!($D(DTOUT))!('$G(Y)) S TIUGO=0
  1.  I $G(TIUPREV)]"" D  S TIUGO=0 G STATUS
  1.  . W !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was already set by another option."
  1.  . W !,"It is --> ",TIUPREV
  1.  . W !,"This Post-Signature Code cannot be altered in this option."
  1.  . W !,"To change the code, please contact your local IT Support Programmer."
  1.  . W !,"'Document Definitions (Manager) / Edit Document' option can be used."
  1.  ;
  1. STATUS ; Check
  1.  I TIUGO=0 Q
  1.  S (TIUFLD,TIUIE,TIUST,Y,Z)=""
  1.  S TIUFLD=.07,TIUIE="I"
  1.  S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE),TIUST=$G(Z)
  1.  I $G(Z)=11 Q
  1.  S TIUIE="E",Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE),TIUST=$G(Z)
  1.  W !!,"The STATUS of this Document Definition Title is '"_TIUST_"'."
  1.  S DIR("A")="Do you want to continue with this title: '"_TIUNAME_"'"
  1.  S DIR("T")=TIUWAIT
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  W ! D ^DIR K DIR
  1.  I $D(DIRUT)!('$G(Y)) S TIUGO=0 Q
  1.  Q
  1.  ;
  1. INTRO ;
  1.  W @IOF
  1.  W !,"This option will setup 'Post-Signature Code Alerts' for PROGRESS NOTES."
  1.  W !,"Please select a choice of RECIPIENTS, and a choice of ROUTINE,"
  1.  W !,"and DEVICE (optional) to receive a printed alert upon note signature."
  1.  W !!,"If both RECIPIENTS and ROUTINE are N/A, a choice of"
  1.  W !,"DELETION or CANCELLATION for the Code Alert setting will be provided.",!!
  1.  S (DA,DIC,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT)=""
  1.  S (H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUGO,TIUIE,TIUIEN)=""
  1.  S (TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWHO,TIUXQA)=""
  1.  S (X,Y,Z,Z1,Z2,ZZ,ZZIEN)=""
  1.  ;
  1. HD ; Header for Enter Post-Signature Code
  1.  S STOP=0,TIUGO=1
  1.  S (H1,H2,I)=""
  1.  S H1="Enter Post-Signature Code for Alert"
  1.  F I=1:1:$L(H1) S H2=H2_"="
  1.  I $G(IOM)="" S IOM=76
  1.  S X=(IOM-$L(H1))/2
  1.  W ! F I=1:1:X W " "
  1.  W H1,! F I=1:1:X W " "
  1.  W H2
  1.  Q
  1.  ;
  1. STOP ; Check Continue
  1.  S X="",STOP=0
  1.  S X="Enter <RETURN> for another TIU Document Definition Name or "
  1.  S X=X_"'^' to exit: "
  1.  W !!,X R Y:TIUWAIT S:'$T Y=U
  1.  I $G(Y)=U S STOP=1,TIUGO=0
  1.  L -^TIU(TIUFLE,TIUIEN)
  1.  Q
  1.  ;
  1. SUBROUT ;
  1.  K TIUARY,TIURTN
  1.  S (I,J,TIUARY,TIURTN,TIUSPEC,Y,Z,Z1,Z2)=""
  1.  S DIR("T")=TIUWAIT
  1.  S DIR("A")="Choose an alert ROUTINE from the above listing"
  1.  S TIUARY=$$GETRTN^TIUPSCA(.TIUARY)
  1.  F I=1:1 Q:$G(TIUARY(I))=""  D  S DIR("A",I)=I_") "_TIURTN(I)
  1.  . S Z="",Z=TIUARY(I)
  1.  . S (J,Z1,Z2)=""
  1.  . S Z1=$P(Z,"-"),Z2=$P(Z,"-",2) F J=1:1:9-$L(Z1) ; S Z1=Z1_" "
  1.  . S TIURTN(I)=Z1_"- "_Z2
  1.  S DIR("A",I)="",J=I-1
  1.  S DIR(0)="NO^1:"_J
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) D  S TIUGO=0 G SUBQ
  1.  . W !!,"ABORT alert ROUTINE - No action is taken."
  1.  I $G(Y)="" W !!,"This is a required response. OR Enter '^' to exit",! H 1 G SUBROUT
  1.  I $G(Y)=1 S TIUSPEC=""
  1.  E  S Z=$G(TIUARY(Y)),TIUSPEC=$P(Z,"-")
  1.  I $G(TIUXQA)="",$G(TIUSPEC)="",$G(TIUPREV)="" D  S TIUGO=0 G SUBQ
  1.  . W !!,"Without RECIPIENT and ROUTINE, alert code setting is cancelled." H 1
  1.  I $G(TIUXQA)="",$G(TIUSPEC)="",$G(TIUPREV)'="" D  G SUBQ
  1.  . S DIR("A")="W/O RECIPIENT and ROUTINE, ALERT CODE will be deleted? (YES or NO)"
  1.  . S DIR("T")=TIUWAIT
  1.  . S DIR(0)="Y"
  1.  . S DIR("B")="NO"
  1.  . W ! D ^DIR K DIR
  1.  . I $D(DIRUT)!'$G(Y) D  S TIUGO=0 Q
  1.  . .  W !!,"No action has been taken!!" S TIUGO=0
  1.  . S TIUGO=0 D DEL Q
  1. SUBQ Q
  1.  ;
  1. WHO ; Select Alert Recipient
  1.  S (TIUWHO,Y)=""
  1.  S DIR(0)="S^N:N/A;I:INDIVIDUAL USER;G:MAILGROUP;T:TEAM LIST (OE/RR with Queued Alert)"
  1.  S DIR("A")="Choose RECIPIENTS to receive the alert (N/I/G/T) or '^' to exit"
  1.  D ^DIR K DIR
  1.  I $D(DTOUT)!($D(DUOUT)) S TIUGO=0 Q  ;G STOP
  1.  S TIUWHO=$G(Y)
  1.  ; XQA set up
  1.  S (TIUFILE,TIUXQA,Y)=""
  1.  S TIUFILE=$S(TIUWHO="I":200,TIUWHO="G":3.8,TIUWHO="T":100.21,1:"")
  1.  S DIC=TIUFILE
  1.  S DIC(0)="AEMQ"
  1.  D ^DIC K DIC
  1.  I $G(Y)'>0 S TIUXQA=""
  1.  E  S TIUXQA=$S(TIUWHO="I":+Y,1:TIUWHO_"."_$$GET1^DIQ(TIUFILE,+Y,.01))
  1.  Q