YSASSN.m

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 ---YSASSN   3787     printed  Feb 18, 2025@23:39:39                                                                                                                                                                                                      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