YS119PS3 ;SLC/KCM - Patch 119 post-init - PCL-5 (cont) ; 9/15/2015
;;5.01;MENTAL HEALTH;**119**;Dec 30, 1994;Build 40
Q
FIXDATE ; fix PCL-5 date prompt
D ADDCHS,ADDCTYPS,ADDCID
N NEWTXT,CHGS
; update question
S NEWTXT="The event happened:"
I ^YTT(601.72,6840,1,1,0)'=NEWTXT D
. S CHGS(1)=NEWTXT D UPDWP^YS119PS0(601.72,6840,.CHGS) K CHGS
S CHGS(3)=1,CHGS(4)=51411
D UPDANY^YS119PS0(601.72,6840,.CHGS)
; update display
K CHGS
S CHGS(8)=8,CHGS(9)="658|||",CHGS(10)=3,CHGS(11)="RA" ; for "A" DLL
D UPDANY^YS119PS0(601.88,92375,.CHGS)
Q
ADDCHS ; add choice entries
D ADD75(3627,"within the past month")
D ADD75(3628,"within the past year")
D ADD75(3629,"within the past 1-5 years")
D ADD75(3630,"within the past 6-10 years")
D ADD75(3631,"more than 10 years ago")
Q
ADD75(ID,TEXT) ; add choice entry
I $D(^YTT(601.75,ID,0)) Q ; already created
N FDA,FDAIEN,DIERR
S FDAIEN(1)=ID
S FDA(601.75,"+1,",.01)=ID
S FDA(601.75,"+1,",3)=TEXT
D UPDATE^DIE("","FDA","FDAIEN")
I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
D CLEAN^DILF
Q
ADDCTYPS ; add choice types
D ADD751(108491,51411,1,3627)
D ADD751(108492,51411,2,3628)
D ADD751(108493,51411,3,3629)
D ADD751(108494,51411,4,3630)
D ADD751(108495,51411,5,3631)
Q
ADD751(IEN,ID,SEQ,CHOICE) ; add choice type entry
I $D(^YTT(601.751,"AC",ID,SEQ,CHOICE)) Q ; already created
I $D(^YTT(601.751,IEN)) F S IEN=IEN+1 Q:'$D(^YTT(601.751,IEN))
N FDA,FDAIEN,DIERR
S FDAIEN(1)=IEN
S FDA(601.751,"+1,",.01)=ID
S FDA(601.751,"+1,",1)=SEQ
S FDA(601.751,"+1,",2)=CHOICE
D UPDATE^DIE("","FDA","FDAIEN")
I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
D CLEAN^DILF
Q
ADDCID ; add choice identifiers
D ADD89(42145,51411,"1")
Q
ADD89(IEN,CHOICE,START) ; add choice identifier
I $D(^YTT(601.89,"B",CHOICE)) D Q ; already created
. N CHGS S CHGS(1)=START
. D UPDANY^YS119PS0(601.89,IEN,.CHGS)
;
I $D(^YTT(601.89,IEN)) F S IEN=IEN+1 Q:'$D(^YTT(601.89,IEN))
N FDA,FDAIEN,DIERR
S FDAIEN(1)=IEN
S FDA(601.89,"+1,",.01)=CHOICE
S FDA(601.89,"+1,",1)=START
D UPDATE^DIE("","FDA","FDAIEN")
I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS119PS3 2262 printed Sep 23, 2025@19:48:08 Page 2
YS119PS3 ;SLC/KCM - Patch 119 post-init - PCL-5 (cont) ; 9/15/2015
+1 ;;5.01;MENTAL HEALTH;**119**;Dec 30, 1994;Build 40
+2 QUIT
FIXDATE ; fix PCL-5 date prompt
+1 DO ADDCHS
DO ADDCTYPS
DO ADDCID
+2 NEW NEWTXT,CHGS
+3 ; update question
+4 SET NEWTXT="The event happened:"
+5 IF ^YTT(601.72,6840,1,1,0)'=NEWTXT
Begin DoDot:1
+6 SET CHGS(1)=NEWTXT
DO UPDWP^YS119PS0(601.72,6840,.CHGS)
KILL CHGS
End DoDot:1
+7 SET CHGS(3)=1
SET CHGS(4)=51411
+8 DO UPDANY^YS119PS0(601.72,6840,.CHGS)
+9 ; update display
+10 KILL CHGS
+11 ; for "A" DLL
SET CHGS(8)=8
SET CHGS(9)="658|||"
SET CHGS(10)=3
SET CHGS(11)="RA"
+12 DO UPDANY^YS119PS0(601.88,92375,.CHGS)
+13 QUIT
ADDCHS ; add choice entries
+1 DO ADD75(3627,"within the past month")
+2 DO ADD75(3628,"within the past year")
+3 DO ADD75(3629,"within the past 1-5 years")
+4 DO ADD75(3630,"within the past 6-10 years")
+5 DO ADD75(3631,"more than 10 years ago")
+6 QUIT
ADD75(ID,TEXT) ; add choice entry
+1 ; already created
IF $DATA(^YTT(601.75,ID,0))
QUIT
+2 NEW FDA,FDAIEN,DIERR
+3 SET FDAIEN(1)=ID
+4 SET FDA(601.75,"+1,",.01)=ID
+5 SET FDA(601.75,"+1,",3)=TEXT
+6 DO UPDATE^DIE("","FDA","FDAIEN")
+7 IF $DATA(DIERR)
DO MES^XPDUTL("ERROR: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
+8 DO CLEAN^DILF
+9 QUIT
ADDCTYPS ; add choice types
+1 DO ADD751(108491,51411,1,3627)
+2 DO ADD751(108492,51411,2,3628)
+3 DO ADD751(108493,51411,3,3629)
+4 DO ADD751(108494,51411,4,3630)
+5 DO ADD751(108495,51411,5,3631)
+6 QUIT
ADD751(IEN,ID,SEQ,CHOICE) ; add choice type entry
+1 ; already created
IF $DATA(^YTT(601.751,"AC",ID,SEQ,CHOICE))
QUIT
+2 IF $DATA(^YTT(601.751,IEN))
FOR
SET IEN=IEN+1
if '$DATA(^YTT(601.751,IEN))
QUIT
+3 NEW FDA,FDAIEN,DIERR
+4 SET FDAIEN(1)=IEN
+5 SET FDA(601.751,"+1,",.01)=ID
+6 SET FDA(601.751,"+1,",1)=SEQ
+7 SET FDA(601.751,"+1,",2)=CHOICE
+8 DO UPDATE^DIE("","FDA","FDAIEN")
+9 IF $DATA(DIERR)
DO MES^XPDUTL("ERROR: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
+10 DO CLEAN^DILF
+11 QUIT
ADDCID ; add choice identifiers
+1 DO ADD89(42145,51411,"1")
+2 QUIT
ADD89(IEN,CHOICE,START) ; add choice identifier
+1 ; already created
IF $DATA(^YTT(601.89,"B",CHOICE))
Begin DoDot:1
+2 NEW CHGS
SET CHGS(1)=START
+3 DO UPDANY^YS119PS0(601.89,IEN,.CHGS)
End DoDot:1
QUIT
+4 ;
+5 IF $DATA(^YTT(601.89,IEN))
FOR
SET IEN=IEN+1
if '$DATA(^YTT(601.89,IEN))
QUIT
+6 NEW FDA,FDAIEN,DIERR
+7 SET FDAIEN(1)=IEN
+8 SET FDA(601.89,"+1,",.01)=CHOICE
+9 SET FDA(601.89,"+1,",1)=START
+10 DO UPDATE^DIE("","FDA","FDAIEN")
+11 IF $DATA(DIERR)
DO MES^XPDUTL("ERROR: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
+12 DO CLEAN^DILF
+13 QUIT
