Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YS187CMT

YS187CMT.m

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