- 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 Apr 23, 2025@18:26:30 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
