- TIURA1 ; SLC/JER - Review screen actions ;3/5/01
- ;;1.0;TEXT INTEGRATION UTILITIES;**20,88,58,100**;Jun 20, 1997
- ADDEND ; Make addenda
- N TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIULST,TIUDAARY
- S TIUI=0
- ; -- Get docmt to addend: --
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
- . N RSTRCTD
- . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
- . D CLEAR^VALM1 W !!,"Making an addendum for #",+TIUDATA
- . ; -- Addend it: --
- . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- . I RSTRCTD D Q
- . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
- . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
- . S TIUDAARY(TIUI)=TIUDA
- . S TIUCHNG=0
- . I +$D(^TIU(8925,+TIUDA,0)) D ADDEND1
- . I +$G(TIUCHNG) D
- . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
- ; -- Update or Rebuild list, restore video:
- I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
- E S TIUCHNG("UPDATE")=1 ; user may have edited existing addm
- D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
- S VALMBCK="R"
- D VMSG^TIURS1($G(TIULST),.TIUDAARY,"addended")
- Q
- ADDEND1 ; Single record Addendum
- ; Receives TIUDA
- N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
- N TIUTYP,TIUT0,TIUDPRM
- I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
- I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
- D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG,1)
- Q
- NAME ; Identify signer(s)
- N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
- N TIUDAARY
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S TIUI=0
- I +$O(VALMY(0)) D FULL^VALM1
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
- . N TIU,VALMY,XQORM,RSTRCTD
- . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
- . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- . I RSTRCTD D Q
- . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
- . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
- . S TIUDAARY(TIUI)=TIUDA
- . S TIUCHNG=0
- . D SIGNER ; SIGNER initializes TIUCHNG to 0
- . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
- NAMEX ; Revise list and cycle back as appropriate
- S TIUCHNG("REFRESH")=1
- D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
- S VALMBCK="R"
- D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Signers identified/edited")
- Q
- SIGNER ; Link selected document to additional signers
- ; Receives TIUDA as pointer to document record
- N TIULIST,TIUI,TIUMORE,TIUCANID S (TIUCHNG,TIUI)=0,TIUMORE=1
- S TIUCANID=$$CANDO^TIULP(TIUDA,"IDENTIFY SIGNERS")
- I +$$MAYCHNG(TIUDA) D Q:'TIUMORE
- . N TIUPRMT S TIUPRMT="Do you Wish to Identify Additional Signers"
- . D CHNGCSNR(TIUDA) S TIUCHNG=1
- . I +$G(TIUCANID) S TIUMORE=$$READ^TIUU("YO",TIUPRMT,"NO")
- . I +$G(TIUCANID)'>0 S TIUMORE=0
- I +$G(TIUCANID)'>0 D Q
- . W !!,$C(7),$P(TIUCANID,U,2),! ; Echo denial message
- . I $$READ^TIUU("EA","RETURN to continue...") ; pause
- I +$O(^TIU(8925.7,"B",TIUDA,0)) D Q:+TIUMORE'>0
- . N DIDEL,DIE,DA,DR,TIUY,TIUPRMT
- . W !,"This Document Already has Additional Expected Signers."
- . D XTRASIGN^TIULX(.TIUY,TIUDA) Q:+$O(TIUY(0))'>0
- . S DA=+$$ASKSIGN^TIULX(.TIUY) Q:+DA'>0
- . S (DIE,DIDEL)=8925.7,DR=".03;I +X>0 S Y=""@1"";.01///@;@1" D ^DIE
- . D SEND^TIUALRT(TIUDA) S TIUCHNG=1
- . S TIUPRMT="Do You Wish to Identify More Additional Signers"
- . S TIUMORE=$$READ^TIUU("Y",TIUPRMT,"NO")
- D PERSEL(.TIULIST,TIUDA) Q:+$D(TIULIST)'>9
- F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D
- . N DA,DIC,DIE,DLAYGO,DR,X,Y
- . S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.7,DIC(0)="LX" D ^DIC Q:+Y'>0
- . S DIE=DIC
- . S DR=".02////"_0_";.03////"_+$G(TIULIST(TIUI))
- . D ^DIE
- . W !,$$SIGNAME^TIULS(+TIULIST(TIUI))," Added as expected signer..." H 2
- . D SEND^TIUALRT(TIUDA)
- . S TIUCHNG=1 K VALMY(TIUI)
- Q
- MAYCHNG(TIUDA) ; Boolean function - can cosigner be modified?
- N TIUD0,TIUD12,TIUY,TIUAUTH,TIUESNR,TIUECSNR S TIUY=0
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
- S TIUAUTH=$P(TIUD12,U,2),TIUESNR=$P(TIUD12,U,4),TIUECSNR=$P(TIUD12,U,8)
- I +TIUECSNR,(+$P(TIUD0,U,5)<7) D
- . S TIUY=$S(DUZ=TIUAUTH:1,DUZ=TIUESNR:1,DUZ=TIUECSNR:1,1:0)
- Q TIUY
- CHNGCSNR(DA) ; Change the expected cosigner
- N DR,DIE,X,Y
- W !,"You may change the expected cosigner, if you wish...",!
- CHNGAGN S DIE=8925,DR="1208R" D ^DIE
- I +$P($G(^TIU(8925,DA,12)),U,8)'>0 W !,$C(7)," Response Required." G CHNGAGN
- D SEND^TIUALRT(DA)
- Q
- PERSEL(TIUY,TIUDA) ; Select a person
- N TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUSCRN S (TIUI,TIUQUIT)=0
- W !!,"Specify other practitioners whose signatures will be expected:",!
- F D Q:+TIUQUIT
- . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
- . S TIUSCRN="I +$$SCREEN^TIURA1(TIUDA,+Y)"
- . S TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"","",TIUSCRN)
- . I +TIUPRSN'>0 S TIUQUIT=1 Q
- . S TIUY(TIUI)=TIUPRSN
- W !
- Q
- SCREEN(TIUDA,Y) ; Evaluate whether a person may be selected as a signer
- N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
- ; A user may NOT select himself
- I Y=+$G(DUZ) S TIUY=0 G SCREENX
- ; Author may NOT be selected
- I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
- ; Expected Signer may NOT be selected
- I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
- ; Can't choose a terminated user
- I '+$$ACTIVE^XUSER(+Y) S TIUY=0 G SCREENX
- ; Can't name the same signer twice
- I +$O(^TIU(8925.7,"AE",+TIUDA,+Y,0)) S TIUY=0 G SCREENX
- S TIUI=0
- F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0!(TIUY=0) D
- . I +$G(TIULIST(TIUI))=+Y S TIUY=0
- I +TIUY=0 G SCREENX
- ; Expected Cosigner may NOT be selected
- I Y=+$P(TIUD12,U,8) S TIUY=0
- SCREENX Q +$G(TIUY)
- ENCNTR ; Enter/edit encounter data on demand
- N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUI,TIUY,TIULST,Y,DIROUT
- N TIUDAARY
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S TIUI=0
- I +$O(VALMY(0)) D FULL^VALM1
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
- . N TIU,VALMY,XQORM,RSTRCTD
- . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
- . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- . I RSTRCTD D Q
- . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
- . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
- . S TIUDAARY(TIUI)=TIUDA
- . S TIUCHNG=0
- . D EDTENC^TIUPXAP2(TIUDA,.TIUCHNG)
- . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
- ENCNTX ; Revise list and cycle back as appropriate
- S TIUCHNG("REFRESH")=1
- D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
- S VALMBCK="R"
- D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Encounter Data Edited")
- Q
- CHARTANY(VALMY) ; Can any of the selected items be printed for the chart?
- N TIUDATA,TIUDA,TIUI,TIUY S (TIUI,TIUY)=0
- F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:+TIUY
- . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
- . S TIUDA=+$P(TIUDATA,U,2)
- . S TIUY=+$$CHARTONE(TIUDA)
- Q TIUY
- CHARTONE(TIUDA) ; Can this document be printed for the chart?
- N TIUDTYP,TIUDPRM
- S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
- D DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
- Q +$P(TIUDPRM(0),U,9)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURA1 6959 printed Jan 18, 2025@03:46:07 Page 2
- TIURA1 ; SLC/JER - Review screen actions ;3/5/01
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**20,88,58,100**;Jun 20, 1997
- ADDEND ; Make addenda
- +1 NEW TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIULST,TIUDAARY
- +2 SET TIUI=0
- +3 ; -- Get docmt to addend: --
- +4 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +5 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +6 NEW RSTRCTD
- +7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +8 DO CLEAR^VALM1
- WRITE !!,"Making an addendum for #",+TIUDATA
- +9 ; -- Addend it: --
- +10 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +11 IF RSTRCTD
- Begin DoDot:2
- +12 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +13 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +14 SET TIUDAARY(TIUI)=TIUDA
- +15 SET TIUCHNG=0
- +16 IF +$DATA(^TIU(8925,+TIUDA,0))
- DO ADDEND1
- +17 IF +$GET(TIUCHNG)
- Begin DoDot:2
- +18 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:2
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- +19 ; -- Update or Rebuild list, restore video:
- +20 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
- SET TIUCHNG("RBLD")=1
- +21 ; user may have edited existing addm
- IF '$TEST
- SET TIUCHNG("UPDATE")=1
- +22 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
- KILL VALMY
- +23 SET VALMBCK="R"
- +24 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"addended")
- +25 QUIT
- ADDEND1 ; Single record Addendum
- +1 ; Receives TIUDA
- +2 NEW %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
- +3 NEW TIUTYP,TIUT0,TIUDPRM
- +4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
- DO SETPARM^TIULE
- +5 IF '+$GET(TIUDA)
- WRITE !,"No Documents selected."
- HANG 2
- QUIT
- +6 DO ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG,1)
- +7 QUIT
- NAME ; Identify signer(s)
- +1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
- +2 NEW TIUDAARY
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET TIUI=0
- +5 IF +$ORDER(VALMY(0))
- DO FULL^VALM1
- +6 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +7 NEW TIU,VALMY,XQORM,RSTRCTD
- +8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +9 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +10 IF RSTRCTD
- Begin DoDot:2
- +11 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +12 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +13 SET TIUDAARY(TIUI)=TIUDA
- +14 SET TIUCHNG=0
- +15 ; SIGNER initializes TIUCHNG to 0
- DO SIGNER
- +16 IF +$GET(TIUCHNG)
- SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- NAMEX ; Revise list and cycle back as appropriate
- +1 SET TIUCHNG("REFRESH")=1
- +2 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
- KILL VALMY
- +3 SET VALMBCK="R"
- +4 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"Signers identified/edited")
- +5 QUIT
- SIGNER ; Link selected document to additional signers
- +1 ; Receives TIUDA as pointer to document record
- +2 NEW TIULIST,TIUI,TIUMORE,TIUCANID
- SET (TIUCHNG,TIUI)=0
- SET TIUMORE=1
- +3 SET TIUCANID=$$CANDO^TIULP(TIUDA,"IDENTIFY SIGNERS")
- +4 IF +$$MAYCHNG(TIUDA)
- Begin DoDot:1
- +5 NEW TIUPRMT
- SET TIUPRMT="Do you Wish to Identify Additional Signers"
- +6 DO CHNGCSNR(TIUDA)
- SET TIUCHNG=1
- +7 IF +$GET(TIUCANID)
- SET TIUMORE=$$READ^TIUU("YO",TIUPRMT,"NO")
- +8 IF +$GET(TIUCANID)'>0
- SET TIUMORE=0
- End DoDot:1
- if 'TIUMORE
- QUIT
- +9 IF +$GET(TIUCANID)'>0
- Begin DoDot:1
- +10 ; Echo denial message
- WRITE !!,$CHAR(7),$PIECE(TIUCANID,U,2),!
- +11 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:1
- QUIT
- +12 IF +$ORDER(^TIU(8925.7,"B",TIUDA,0))
- Begin DoDot:1
- +13 NEW DIDEL,DIE,DA,DR,TIUY,TIUPRMT
- +14 WRITE !,"This Document Already has Additional Expected Signers."
- +15 DO XTRASIGN^TIULX(.TIUY,TIUDA)
- if +$ORDER(TIUY(0))'>0
- QUIT
- +16 SET DA=+$$ASKSIGN^TIULX(.TIUY)
- if +DA'>0
- QUIT
- +17 SET (DIE,DIDEL)=8925.7
- SET DR=".03;I +X>0 S Y=""@1"";.01///@;@1"
- DO ^DIE
- +18 DO SEND^TIUALRT(TIUDA)
- SET TIUCHNG=1
- +19 SET TIUPRMT="Do You Wish to Identify More Additional Signers"
- +20 SET TIUMORE=$$READ^TIUU("Y",TIUPRMT,"NO")
- End DoDot:1
- if +TIUMORE'>0
- QUIT
- +21 DO PERSEL(.TIULIST,TIUDA)
- if +$DATA(TIULIST)'>9
- QUIT
- +22 FOR
- SET TIUI=$ORDER(TIULIST(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +23 NEW DA,DIC,DIE,DLAYGO,DR,X,Y
- +24 SET X=""""_"`"_TIUDA_""""
- SET (DIC,DLAYGO)=8925.7
- SET DIC(0)="LX"
- DO ^DIC
- if +Y'>0
- QUIT
- +25 SET DIE=DIC
- +26 SET DR=".02////"_0_";.03////"_+$GET(TIULIST(TIUI))
- +27 DO ^DIE
- +28 WRITE !,$$SIGNAME^TIULS(+TIULIST(TIUI))," Added as expected signer..."
- HANG 2
- +29 DO SEND^TIUALRT(TIUDA)
- +30 SET TIUCHNG=1
- KILL VALMY(TIUI)
- End DoDot:1
- +31 QUIT
- MAYCHNG(TIUDA) ; Boolean function - can cosigner be modified?
- +1 NEW TIUD0,TIUD12,TIUY,TIUAUTH,TIUESNR,TIUECSNR
- SET TIUY=0
- +2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
- +3 SET TIUAUTH=$PIECE(TIUD12,U,2)
- SET TIUESNR=$PIECE(TIUD12,U,4)
- SET TIUECSNR=$PIECE(TIUD12,U,8)
- +4 IF +TIUECSNR
- IF (+$PIECE(TIUD0,U,5)<7)
- Begin DoDot:1
- +5 SET TIUY=$SELECT(DUZ=TIUAUTH:1,DUZ=TIUESNR:1,DUZ=TIUECSNR:1,1:0)
- End DoDot:1
- +6 QUIT TIUY
- CHNGCSNR(DA) ; Change the expected cosigner
- +1 NEW DR,DIE,X,Y
- +2 WRITE !,"You may change the expected cosigner, if you wish...",!
- CHNGAGN SET DIE=8925
- SET DR="1208R"
- DO ^DIE
- +1 IF +$PIECE($GET(^TIU(8925,DA,12)),U,8)'>0
- WRITE !,$CHAR(7)," Response Required."
- GOTO CHNGAGN
- +2 DO SEND^TIUALRT(DA)
- +3 QUIT
- PERSEL(TIUY,TIUDA) ; Select a person
- +1 NEW TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUSCRN
- SET (TIUI,TIUQUIT)=0
- +2 WRITE !!,"Specify other practitioners whose signatures will be expected:",!
- +3 FOR
- Begin DoDot:1
- +4 SET TIUI=TIUI+1
- SET TIUPRMT=$JUSTIFY(TIUI,3)_") "
- +5 SET TIUSCRN="I +$$SCREEN^TIURA1(TIUDA,+Y)"
- +6 SET TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"","",TIUSCRN)
- +7 IF +TIUPRSN'>0
- SET TIUQUIT=1
- QUIT
- +8 SET TIUY(TIUI)=TIUPRSN
- End DoDot:1
- if +TIUQUIT
- QUIT
- +9 WRITE !
- +10 QUIT
- SCREEN(TIUDA,Y) ; Evaluate whether a person may be selected as a signer
- +1 ; most people may be selected
- NEW TIUI,TIUY,TIUD0,TIUD12
- SET TIUY=1
- +2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
- +3 ; A user may NOT select himself
- +4 IF Y=+$GET(DUZ)
- SET TIUY=0
- GOTO SCREENX
- +5 ; Author may NOT be selected
- +6 IF Y=+$PIECE(TIUD12,U,2)
- SET TIUY=0
- GOTO SCREENX
- +7 ; Expected Signer may NOT be selected
- +8 IF Y=+$PIECE(TIUD12,U,4)
- SET TIUY=0
- GOTO SCREENX
- +9 ; Can't choose a terminated user
- +10 IF '+$$ACTIVE^XUSER(+Y)
- SET TIUY=0
- GOTO SCREENX
- +11 ; Can't name the same signer twice
- +12 IF +$ORDER(^TIU(8925.7,"AE",+TIUDA,+Y,0))
- SET TIUY=0
- GOTO SCREENX
- +13 SET TIUI=0
- +14 FOR
- SET TIUI=$ORDER(TIULIST(TIUI))
- if +TIUI'>0!(TIUY=0)
- QUIT
- Begin DoDot:1
- +15 IF +$GET(TIULIST(TIUI))=+Y
- SET TIUY=0
- End DoDot:1
- +16 IF +TIUY=0
- GOTO SCREENX
- +17 ; Expected Cosigner may NOT be selected
- +18 IF Y=+$PIECE(TIUD12,U,8)
- SET TIUY=0
- SCREENX QUIT +$GET(TIUY)
- ENCNTR ; Enter/edit encounter data on demand
- +1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUI,TIUY,TIULST,Y,DIROUT
- +2 NEW TIUDAARY
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET TIUI=0
- +5 IF +$ORDER(VALMY(0))
- DO FULL^VALM1
- +6 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +7 NEW TIU,VALMY,XQORM,RSTRCTD
- +8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +9 SET TIUDA=+$PIECE(TIUDATA,U,2)
- SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
- +10 IF RSTRCTD
- Begin DoDot:2
- +11 ; Echo denial message
- WRITE !!,$CHAR(7),"Ok, no harm done...",!
- +12 ; pause
- IF $$READ^TIUU("EA","RETURN to continue...")
- End DoDot:2
- QUIT
- +13 SET TIUDAARY(TIUI)=TIUDA
- +14 SET TIUCHNG=0
- +15 DO EDTENC^TIUPXAP2(TIUDA,.TIUCHNG)
- +16 IF +$GET(TIUCHNG)
- SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
- End DoDot:1
- if $DATA(DIROUT)
- QUIT
- ENCNTX ; Revise list and cycle back as appropriate
- +1 SET TIUCHNG("REFRESH")=1
- +2 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
- KILL VALMY
- +3 SET VALMBCK="R"
- +4 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"Encounter Data Edited")
- +5 QUIT
- CHARTANY(VALMY) ; Can any of the selected items be printed for the chart?
- +1 NEW TIUDATA,TIUDA,TIUI,TIUY
- SET (TIUI,TIUY)=0
- +2 FOR
- SET TIUI=$ORDER(VALMY(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +3 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- +4 SET TIUDA=+$PIECE(TIUDATA,U,2)
- +5 SET TIUY=+$$CHARTONE(TIUDA)
- End DoDot:1
- if +TIUY
- QUIT
- +6 QUIT TIUY
- CHARTONE(TIUDA) ; Can this document be printed for the chart?
- +1 NEW TIUDTYP,TIUDPRM
- +2 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
- +3 DO DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
- +4 QUIT +$PIECE(TIUDPRM(0),U,9)