YSASSN ;692/DCL-ASI SIGNATURE AND NARRATIVE ;4/7/98 14:08
;;5.01;MENTAL HEALTH;**24,39**;Dec 30, 1994
Q
ES(YSASS) ;Electronc Signature - Pass flag by reference
;YSASS= 0-FAILED, 1-SUCCESS
N X,X1
S YSASS=0
D SIG^XUSESIG
I X1="" D Q
.W $C(7),!,"SIGNATURE FAILED"
.W !,"< ASI SAVED - WITHOUT SIGNATURE >"
.Q
S YSASS=1 ;signature ok
Q
;
NARYN(YSAS1) ;Narrative Yes or No
N YSAS2,DIR,X,Y
S YSAS1=""
S DIR(0)="Y"
S DIR("A")="ENTER A NARRATIVE FOR THIS ASI "
S DIR("B")="YES"
D ^DIR
S YSAS1=Y
Q
;
EN(YSAIEN) ;Entry point
N YSAS,YSAS,YSASFLG,YSASINTV,DIC,DIE,DA,DR,X,Y,YSASPN,YSASPT,YSASPIEN
N YSASSGNT,YSASSPL,YSASTRS,YSASBUL
;YSASSGNT=DATE/TIME SIGNED
;YSASFLG=to determine if any important fields are missing.
;YSASTRS=Transcriber -
;YSASBUL=Send Bulletin via e-mail informing the interviewer of the ASI to sign, which was transcribed by someonelse
;YSASINTV=Interviewer - can only be signed by interviewer or an ASI Manager
S YSASCL=$$F(.04,"I")
D:YSASCL'=2 OUT2^YSASO1(YSAIEN,.YSASFLG)
D:YSASCL=2 OUT3^YSASO2(YSAIEN,.YSASFLG)
S YSASSPL=$$F(.11,"I"),YSASPN=$P($G(^YSTX(604.8,1,0)),"^",5)
D CHECKALL^YSASO2(YSAIEN,.YSASFLG) ;FULL REQUIREMENT CHECK
I YSASSPL?1N&(YSASFLG=0) D
.W $C(7),!!,"< ASI NOT COMPLETE - SPECIAL CODE:",$$F(.11)," >",!
. K DIR S DIR(0)="Y",DIR("A")="Do you want to sign this ASI as complete even though the patient "_$S(YSASSPL=1:"terminated",YSASSPL=2:"refused",1:"was unable to respond")
. D ^DIR S:Y=1 YSASFLG=1
.Q
I YSASFLG=0 D Q
.W $C(7),!!,"< NO SIGNATURE REQUESTED, ASI HAS MISSING DATA >"
.W !,"< MUST COMPLETE REQUIRED FIELDS >"
.W !,"< ASI SAVED - WITHOUT SIGNATURE AND WITHOUT PROGRESS NOTE >"
. K DIR S DIR(0)="Y",DIR("A")="Display missing required fields",DIR("B")="NO"
. D ^DIR I Y=1 D REPTMSG^YSASO2(YSAIEN) Q
.Q
S YSASINTV=$$F(.09,"I"),YSASPT=$$F(.02,"I") ; $$GET1^DIQ(604,YSAIEN_",",.09,"I")
S YSASTRS=$$F(.14,"I")
I YSASINTV'>0 D Q
. W $C(7),!!,"< NO SIGNATURE REQUESTED, ASI HAS MISSING DATA >"
.W !,"< MUST COMPLETE NAME OF INTERVIEWER >"
.W !,"< ASI SAVED - WITHOUT SIGNATURE AND WITHOUT PROGRESS NOTE >"
.W !!,"<press <cr> to continue>"
.R X:DTIME
.Q
XN ;
D:YSASFLG=2
. K DIR S DIR(0)="Y",DIR("A")="Display required fields answered X or N",DIR("B")="NO"
. D ^DIR I Y=1 D REPTMSG^YSASO2(YSAIEN)
;
I YSASFLG!(YSASSPL) D
.I YSASINTV=YSASTRS,YSASTRS=DUZ,YSASTRS>0 D ES(.YSAS) Q
.I $D(^YSTX(604.8,"AB",DUZ)) D Q
..W !,$$AS("ASI Package Manager")
..D ES(.YSAS)
..Q
.I YSASINTV=DUZ D ES(.YSAS) Q
.I YSASTRS=DUZ,YSASINTV'=DUZ D Q
..W !,$$AS("Transcriber")
..D ES(.YSAS)
..S:$G(YSAS) YSASBUL=1
..Q
.Q
I $G(YSAS),$G(YSASBUL) D Q
.;send bulletin and change turn over responsibility for ASI to interviewer, who will be able to sign/create progress note
.W !,"...Sending bulletin to Interviewer..."
.D BUL^YSASBUL(YSAIEN,YSASTRS,YSASINTV)
.W !,"...Turning over ASI to Interviewer for action..."
.D CONV^YSASCR(YSAIEN,YSASINTV)
.Q
I '$G(YSAS),YSASPN>0 W !,"< NO PROGRESS NOTE >"
Q:$G(YSAS)'>0
S YSASSGNT=$$FMADD^XLFDT($$NOW^XLFDT,0,0,-1)
I YSASPN>0 D
.;W !!,"...Creating ASI Progress Note..."
. ;D PN^YSASPN(YSAIEN,YSASPT,DUZ,YSASPN,.YSASPIEN,YSASSGNT)
. D MAIN^YSASPNT(YSAIEN) ;TIU Pnotes
.Q
W !,"...Closing ASI Record..."
D CR^YSASCR(YSAIEN,DUZ,$G(YSASPIEN))
W "done!",!
W !!,"<press <cr> to continue>"
R X:DTIME
Q
;other wise check id duz is interviewer and or transcriber and file in record
;
;
F(YSASFLD,YSASFLG) ;Pass field name - IEN is expected to be in YSASIEN
N DIERR
Q:$G(YSASFLD)=""
Q $$GET1^DIQ(604,YSAIEN_",",YSASFLD,$G(YSASFLG))
;
AS(X) ;Requesting Electronic Signature as - passed in X
Q "Requesting Electronic Signature as "_X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASSN 3787 printed Sep 23, 2025@19:49:27 Page 2
YSASSN ;692/DCL-ASI SIGNATURE AND NARRATIVE ;4/7/98 14:08
+1 ;;5.01;MENTAL HEALTH;**24,39**;Dec 30, 1994
+2 QUIT
ES(YSASS) ;Electronc Signature - Pass flag by reference
+1 ;YSASS= 0-FAILED, 1-SUCCESS
+2 NEW X,X1
+3 SET YSASS=0
+4 DO SIG^XUSESIG
+5 IF X1=""
Begin DoDot:1
+6 WRITE $CHAR(7),!,"SIGNATURE FAILED"
+7 WRITE !,"< ASI SAVED - WITHOUT SIGNATURE >"
+8 QUIT
End DoDot:1
QUIT
+9 ;signature ok
SET YSASS=1
+10 QUIT
+11 ;
NARYN(YSAS1) ;Narrative Yes or No
+1 NEW YSAS2,DIR,X,Y
+2 SET YSAS1=""
+3 SET DIR(0)="Y"
+4 SET DIR("A")="ENTER A NARRATIVE FOR THIS ASI "
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 SET YSAS1=Y
+8 QUIT
+9 ;
EN(YSAIEN) ;Entry point
+1 NEW YSAS,YSAS,YSASFLG,YSASINTV,DIC,DIE,DA,DR,X,Y,YSASPN,YSASPT,YSASPIEN
+2 NEW YSASSGNT,YSASSPL,YSASTRS,YSASBUL
+3 ;YSASSGNT=DATE/TIME SIGNED
+4 ;YSASFLG=to determine if any important fields are missing.
+5 ;YSASTRS=Transcriber -
+6 ;YSASBUL=Send Bulletin via e-mail informing the interviewer of the ASI to sign, which was transcribed by someonelse
+7 ;YSASINTV=Interviewer - can only be signed by interviewer or an ASI Manager
+8 SET YSASCL=$$F(.04,"I")
+9 if YSASCL'=2
DO OUT2^YSASO1(YSAIEN,.YSASFLG)
+10 if YSASCL=2
DO OUT3^YSASO2(YSAIEN,.YSASFLG)
+11 SET YSASSPL=$$F(.11,"I")
SET YSASPN=$PIECE($GET(^YSTX(604.8,1,0)),"^",5)
+12 ;FULL REQUIREMENT CHECK
DO CHECKALL^YSASO2(YSAIEN,.YSASFLG)
+13 IF YSASSPL?1N&(YSASFLG=0)
Begin DoDot:1
+14 WRITE $CHAR(7),!!,"< ASI NOT COMPLETE - SPECIAL CODE:",$$F(.11)," >",!
+15 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to sign this ASI as complete even though the patient "_$SELECT(YSASSPL=1:"terminated",YSASSPL=2:"refused",1:"was unable to respond")
+16 DO ^DIR
if Y=1
SET YSASFLG=1
+17 QUIT
End DoDot:1
+18 IF YSASFLG=0
Begin DoDot:1
+19 WRITE $CHAR(7),!!,"< NO SIGNATURE REQUESTED, ASI HAS MISSING DATA >"
+20 WRITE !,"< MUST COMPLETE REQUIRED FIELDS >"
+21 WRITE !,"< ASI SAVED - WITHOUT SIGNATURE AND WITHOUT PROGRESS NOTE >"
+22 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Display missing required fields"
SET DIR("B")="NO"
+23 DO ^DIR
IF Y=1
DO REPTMSG^YSASO2(YSAIEN)
QUIT
+24 QUIT
End DoDot:1
QUIT
+25 ; $$GET1^DIQ(604,YSAIEN_",",.09,"I")
SET YSASINTV=$$F(.09,"I")
SET YSASPT=$$F(.02,"I")
+26 SET YSASTRS=$$F(.14,"I")
+27 IF YSASINTV'>0
Begin DoDot:1
+28 WRITE $CHAR(7),!!,"< NO SIGNATURE REQUESTED, ASI HAS MISSING DATA >"
+29 WRITE !,"< MUST COMPLETE NAME OF INTERVIEWER >"
+30 WRITE !,"< ASI SAVED - WITHOUT SIGNATURE AND WITHOUT PROGRESS NOTE >"
+31 WRITE !!,"<press <cr> to continue>"
+32 READ X:DTIME
+33 QUIT
End DoDot:1
QUIT
XN ;
+1 if YSASFLG=2
Begin DoDot:1
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Display required fields answered X or N"
SET DIR("B")="NO"
+3 DO ^DIR
IF Y=1
DO REPTMSG^YSASO2(YSAIEN)
End DoDot:1
+4 ;
+5 IF YSASFLG!(YSASSPL)
Begin DoDot:1
+6 IF YSASINTV=YSASTRS
IF YSASTRS=DUZ
IF YSASTRS>0
DO ES(.YSAS)
QUIT
+7 IF $DATA(^YSTX(604.8,"AB",DUZ))
Begin DoDot:2
+8 WRITE !,$$AS("ASI Package Manager")
+9 DO ES(.YSAS)
+10 QUIT
End DoDot:2
QUIT
+11 IF YSASINTV=DUZ
DO ES(.YSAS)
QUIT
+12 IF YSASTRS=DUZ
IF YSASINTV'=DUZ
Begin DoDot:2
+13 WRITE !,$$AS("Transcriber")
+14 DO ES(.YSAS)
+15 if $GET(YSAS)
SET YSASBUL=1
+16 QUIT
End DoDot:2
QUIT
+17 QUIT
End DoDot:1
+18 IF $GET(YSAS)
IF $GET(YSASBUL)
Begin DoDot:1
+19 ;send bulletin and change turn over responsibility for ASI to interviewer, who will be able to sign/create progress note
+20 WRITE !,"...Sending bulletin to Interviewer..."
+21 DO BUL^YSASBUL(YSAIEN,YSASTRS,YSASINTV)
+22 WRITE !,"...Turning over ASI to Interviewer for action..."
+23 DO CONV^YSASCR(YSAIEN,YSASINTV)
+24 QUIT
End DoDot:1
QUIT
+25 IF '$GET(YSAS)
IF YSASPN>0
WRITE !,"< NO PROGRESS NOTE >"
+26 if $GET(YSAS)'>0
QUIT
+27 SET YSASSGNT=$$FMADD^XLFDT($$NOW^XLFDT,0,0,-1)
+28 IF YSASPN>0
Begin DoDot:1
+29 ;W !!,"...Creating ASI Progress Note..."
+30 ;D PN^YSASPN(YSAIEN,YSASPT,DUZ,YSASPN,.YSASPIEN,YSASSGNT)
+31 ;TIU Pnotes
DO MAIN^YSASPNT(YSAIEN)
+32 QUIT
End DoDot:1
+33 WRITE !,"...Closing ASI Record..."
+34 DO CR^YSASCR(YSAIEN,DUZ,$GET(YSASPIEN))
+35 WRITE "done!",!
+36 WRITE !!,"<press <cr> to continue>"
+37 READ X:DTIME
+38 QUIT
+39 ;other wise check id duz is interviewer and or transcriber and file in record
+40 ;
+41 ;
F(YSASFLD,YSASFLG) ;Pass field name - IEN is expected to be in YSASIEN
+1 NEW DIERR
+2 if $GET(YSASFLD)=""
QUIT
+3 QUIT $$GET1^DIQ(604,YSAIEN_",",YSASFLD,$GET(YSASFLG))
+4 ;
AS(X) ;Requesting Electronic Signature as - passed in X
+1 QUIT "Requesting Electronic Signature as "_X
