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

YS139PST.m

Go to the documentation of this file. 
  1. YS139PST ;SLC/BLD - MH Exchange Sample Code  ; 10/11/18 3:01pm
  1.  ;;5.01;MENTAL HEALTH;**139**;Dec 30, 1994;Build 134
  1.  ;
  1. EXPDATE ; export date used to update 601.71:18
  1.  ;;3190801.1956
  1.  ;
  1. PRE ; nothing necessary
  1.  Q
  1. POST ; post-init
  1.  ; UPDSET^YTXCHG("TAG","RTN") will loop through the array returned by TAG^RTN
  1.  ; and install the specification supplied by that Instrument Exchange entry
  1.  ; name.
  1.  ;
  1.  N I,YTXLOG,LSTEDT,OLD,NEW,NEWDT,REC,IEN
  1.  ;
  1.  S LSTEDT=$P($T(EXPDATE+1),";;",2)
  1.  D CHGNM("DERS","D.ERS")
  1.  D DROPTST("RAID")
  1.  ;
  1.  D INSTALLQ^YTXCHG("XCHGLST","YS139PST")
  1.  D MODDATA   ;CHANGE LAST EDIT DATE, WRITE FULL TEXT, GENERATE PNOTE AND R PRIVILEGE ON INSTRUMENTS IN PATCH
  1.  ;
  1.  Q 
  1.  ;
  1. MODDATA ; Set new dates for tests listed so the GUI will reload the definition
  1.  ; This is best done in the account where the build is created so that the
  1.  ; original and destination accounts match.
  1.  N I,X,NEWDT,REC
  1.  S NEWDT=$P($T(EXPDATE+1),";;",2)
  1.  F I=1:1 S X=$P($T(INSTDT+I),";;",2) Q:X="zzzzz"  D   ; D NEWDATE^YTXCHGU(X,NEWDT)
  1.  .K REC
  1.  .S IEN=$O(^YTT(601.71,"B",$P(X,"^",1),""))
  1.  .S REC(18)=NEWDT       ;LAST EDIT DATE
  1.  .I $P(X,"^",2)'="" S REC(26)=$P(X,"^",2) ; WRITE FULL TEXT
  1.  .I $P(X,"^",3)'="" S REC(28)=$P(X,"^",3) ;GENERATE PNOTE
  1.  .I $P(X,"^",4)'="" S REC(9)=$P(X,"^",4)  ;R PRIVILEGE
  1.  .D FMUPD^YTXCHGU(601.71,.REC,IEN)
  1.  Q
  1.  ;
  1. INSTDT ;
  1.  ;;BBHI-2^N^N^YSP
  1.  ;;COPD^Y^Y^
  1.  ;;CSDD-RS^Y^Y^
  1.  ;;D.ERS^Y^Y^
  1.  ;;BPRS-A^Y^^
  1.  ;;HSI^Y^^
  1.  ;;MHRM^Y^^
  1.  ;;MPI-PAIN-INTRF^Y^^
  1.  ;;PCL-5 WEEKLY^Y^^
  1.  ;;PC-PTSD-5+I9^Y^^
  1.  ;;PHQ-2+I9^Y^^
  1.  ;;PSS-3 2ND^Y^^
  1.  ;;QOLI^N^N^
  1.  ;;RAID^N^N^
  1.  ;;zzzzz
  1.  ;
  1. CHGNM(OLD,NEW) ; Change test name
  1.  N REC,IEN
  1.  S IEN=$O(^YTT(601.71,"B",OLD,0))
  1.  I 'IEN QUIT  ; already updated
  1.  S REC(.01)=NEW
  1.  S REC(18)=LSTEDT
  1.  D FMUPD^YTXCHGU(601.71,.REC,IEN)
  1.  Q
  1.  ;
  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(EXPDATE+1),";;",2)
  1.  D FMUPD^YTXCHGU(601.71,.REC,IEN)
  1.  Q
  1.  ;
  1.  ;
  1. SCREEN ; sample line to put in DATA SCREEN of KIDS build
  1.  ; $$INCLUDE^YTXCHG(Y,"TAG","RTN") calls TAG^RTN to get an array of
  1.  ; instrument exchange entries to include in the build.  It sets Y
  1.  ; to true if the entry should be included.
  1.  ; 
  1.  I $$INCLUDE^YTXCHG(Y,"XCHGLST","YS139PST")
  1.  Q
  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*139^08/15/2019@13:36:22
  1.   ;;zzzzz
  1.  ;;YS*5.01*139^01/18/2019@13:10:05
  1.  ;;YS*5.01*139^02/20/2019@10:33:29
  1.  ;;YS*5.01*139 V31^08/12/2019@12:53:21
  1.  ;;YS*5.01*139^08/15/2019@13:36:22