YS187CMT ;SLC/KCM - Note titles for Case Mix Tool ; 11/18/2021
;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
;
; BMES^XPDUTL ICR # 10141
; FIND1^DIC ICR # 2051
; $$CRDD^TIUCRDD ICR # 7179
; $$DDEFIEN^TIUFLF7 ICR # 5352
Q
;
EDTDATE ; date used to update 601.71:18
;;3211207.1247
Q
POST ; Post-init specific to Case Mix Tool
N NDCL S NDCL="GEC PROGRESS NOTES" ; new class
N NOTE S NOTE="PERSONAL CARE SERVICES CASE MIX TOOL" ; note
;N CSLT S CSLT="PERSONAL CARE SERVICES CASE MIX TOOL FOR CONSULT" ; consult
N CSLT S CSLT="COMMUNITY CARE-GEC HOMEMAKER/HOME HEALTH AIDE" ; consult
N STDT S STDT="GERIATRIC MEDICINE NOTE" ; standard
D ADTITLES(NDCL,NOTE,CSLT,STDT) ; add the new note titles
D INSTALLQ^YTXCHG("XCHGLST","YS187CMT") ; update Case Mix instrument entries
D UPD71(NOTE,CSLT) ; point CASE MIX to new titles
D DROPTST("SSF") ; inactivate SSF instrument
D DROPTST("ZUNG") ; inactivate ZUNG instrument
Q
;
ADTITLES(NDCL,NOTE,CSLT,STDT) ; add new titles for Case Mix if not there
N RV ; holds return value
; install new parent document class
S RV=$$CRDD^TIUCRDD(NDCL,"DC",11,"PROGRESS NOTES")
I '+RV,$P(RV,U,2)'["already exists" D BMES^XPDUTL($P(RV,U,2)) QUIT ; out
D BMES^XPDUTL($S(+RV:NDCL_" created successfully",1:NDCL_" already exists"))
; install progress note title
S RV=$$CRDD^TIUCRDD(NOTE,"DOC",11,NDCL,STDT)
D BMES^XPDUTL($S(+RV:NOTE_" created successfully",1:$P(RV,U,2)))
; install consult title
; S RV=$$CRDD^TIUCRDD(CSLT,"DOC",11,"CONSULTS",STDT)
; D BMES^XPDUTL($S(+RV:CSLT_" created successfully",1:$P(RV,U,2)))
Q
;
UPD71(NOTE,CSLT) ; update titles in MH TESTS AND SURVEYS (#601.71)
N TESTIEN,NOTEIEN,CSLTIEN,REC
S TESTIEN=$O(^YTT(601.71,"B","CASE MIX",0)) Q:'TESTIEN
S NOTEIEN=+$$DDEFIEN^TIUFLF7(NOTE,"TL")
S CSLTIEN=+$$DDEFIEN^TIUFLF7(CSLT,"TL")
I 'NOTEIEN,'CSLTIEN QUIT ; neither title found
S REC(28)="Y"
I NOTEIEN S REC(29)=NOTEIEN
I CSLTIEN S REC(30)=CSLTIEN
D FMUPD^YTXCHGU(601.71,.REC,TESTIEN)
D BMES^XPDUTL("Note titles updated for Case Mix.")
Q
DROPTST(NAME) ; Change OPERATIONAL to dropped
N IEN,REC
S IEN=$O(^YTT(601.71,"B",NAME,0)) Q:'IEN
S REC(10)="D"
S REC(18)=$P($T(EDTDATE+1),";;",2)
D FMUPD^YTXCHGU(601.71,.REC,IEN)
Q
;
; added to data screen:
; I $$INCLUDE^YTXCHG(Y,"XCHGLST","YS187CMT")
;
XCHGLST(ARRAY) ; return array of instrument exchange entries
; ARRAY(cnt,1)=instrument exchange entry name
; ARRAY(cnt,2)=instrument exchange entry creation date
;
N I,X
F I=1:1 S X=$P($T(ENTRIES+I),";;",2,99) Q:X="zzzzz" D
. S ARRAY(I,1)=$P(X,U)
. S ARRAY(I,2)=$P(X,U,2)
Q
ENTRIES ; New MHA instruments ^ Exchange Entry Date
;;YS*5.01*187 CASE MIX FIX^12/03/2021@10:51:15
;;zzzzz
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS187CMT 2928 printed Apr 09, 2024@21:15:24 Page 2
YS187CMT ;SLC/KCM - Note titles for Case Mix Tool ; 11/18/2021
+1 ;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
+2 ;
+3 ; BMES^XPDUTL ICR # 10141
+4 ; FIND1^DIC ICR # 2051
+5 ; $$CRDD^TIUCRDD ICR # 7179
+6 ; $$DDEFIEN^TIUFLF7 ICR # 5352
+7 QUIT
+8 ;
EDTDATE ; date used to update 601.71:18
+1 ;;3211207.1247
+2 QUIT
POST ; Post-init specific to Case Mix Tool
+1 ; new class
NEW NDCL
SET NDCL="GEC PROGRESS NOTES"
+2 ; note
NEW NOTE
SET NOTE="PERSONAL CARE SERVICES CASE MIX TOOL"
+3 ;N CSLT S CSLT="PERSONAL CARE SERVICES CASE MIX TOOL FOR CONSULT" ; consult
+4 ; consult
NEW CSLT
SET CSLT="COMMUNITY CARE-GEC HOMEMAKER/HOME HEALTH AIDE"
+5 ; standard
NEW STDT
SET STDT="GERIATRIC MEDICINE NOTE"
+6 ; add the new note titles
DO ADTITLES(NDCL,NOTE,CSLT,STDT)
+7 ; update Case Mix instrument entries
DO INSTALLQ^YTXCHG("XCHGLST","YS187CMT")
+8 ; point CASE MIX to new titles
DO UPD71(NOTE,CSLT)
+9 ; inactivate SSF instrument
DO DROPTST("SSF")
+10 ; inactivate ZUNG instrument
DO DROPTST("ZUNG")
+11 QUIT
+12 ;
ADTITLES(NDCL,NOTE,CSLT,STDT) ; add new titles for Case Mix if not there
+1 ; holds return value
NEW RV
+2 ; install new parent document class
+3 SET RV=$$CRDD^TIUCRDD(NDCL,"DC",11,"PROGRESS NOTES")
+4 ; out
IF '+RV
IF $PIECE(RV,U,2)'["already exists"
DO BMES^XPDUTL($PIECE(RV,U,2))
QUIT
+5 DO BMES^XPDUTL($SELECT(+RV:NDCL_" created successfully",1:NDCL_" already exists"))
+6 ; install progress note title
+7 SET RV=$$CRDD^TIUCRDD(NOTE,"DOC",11,NDCL,STDT)
+8 DO BMES^XPDUTL($SELECT(+RV:NOTE_" created successfully",1:$PIECE(RV,U,2)))
+9 ; install consult title
+10 ; S RV=$$CRDD^TIUCRDD(CSLT,"DOC",11,"CONSULTS",STDT)
+11 ; D BMES^XPDUTL($S(+RV:CSLT_" created successfully",1:$P(RV,U,2)))
+12 QUIT
+13 ;
UPD71(NOTE,CSLT) ; update titles in MH TESTS AND SURVEYS (#601.71)
+1 NEW TESTIEN,NOTEIEN,CSLTIEN,REC
+2 SET TESTIEN=$ORDER(^YTT(601.71,"B","CASE MIX",0))
if 'TESTIEN
QUIT
+3 SET NOTEIEN=+$$DDEFIEN^TIUFLF7(NOTE,"TL")
+4 SET CSLTIEN=+$$DDEFIEN^TIUFLF7(CSLT,"TL")
+5 ; neither title found
IF 'NOTEIEN
IF 'CSLTIEN
QUIT
+6 SET REC(28)="Y"
+7 IF NOTEIEN
SET REC(29)=NOTEIEN
+8 IF CSLTIEN
SET REC(30)=CSLTIEN
+9 DO FMUPD^YTXCHGU(601.71,.REC,TESTIEN)
+10 DO BMES^XPDUTL("Note titles updated for Case Mix.")
+11 QUIT
DROPTST(NAME) ; Change OPERATIONAL to dropped
+1 NEW IEN,REC
+2 SET IEN=$ORDER(^YTT(601.71,"B",NAME,0))
if 'IEN
QUIT
+3 SET REC(10)="D"
+4 SET REC(18)=$PIECE($TEXT(EDTDATE+1),";;",2)
+5 DO FMUPD^YTXCHGU(601.71,.REC,IEN)
+6 QUIT
+7 ;
+8 ; added to data screen:
+9 ; I $$INCLUDE^YTXCHG(Y,"XCHGLST","YS187CMT")
+10 ;
XCHGLST(ARRAY) ; return array of instrument exchange entries
+1 ; ARRAY(cnt,1)=instrument exchange entry name
+2 ; ARRAY(cnt,2)=instrument exchange entry creation date
+3 ;
+4 NEW I,X
+5 FOR I=1:1
SET X=$PIECE($TEXT(ENTRIES+I),";;",2,99)
if X="zzzzz"
QUIT
Begin DoDot:1
+6 SET ARRAY(I,1)=$PIECE(X,U)
+7 SET ARRAY(I,2)=$PIECE(X,U,2)
End DoDot:1
+8 QUIT
ENTRIES ; New MHA instruments ^ Exchange Entry Date
+1 ;;YS*5.01*187 CASE MIX FIX^12/03/2021@10:51:15
+2 ;;zzzzz
+3 QUIT
