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

CRHD6.m

Go to the documentation of this file. 
  1. CRHD6 ; CAIRO/CLC - MISC ROUTINE FOR CAIRO HAND-OFF TOOL ;06-Aug-2018 15:00;
  1.  ;;1.0;CRHD;**8**;Jan 28, 2008;Build 14
  1.  ;=================================================================
  1. GETP(CRHDRTN,CRHDE) ;
  1.  N CRHDPAR,Y,CRHDX,CRHDCT,CRHDMN,CRHDP,CRHDE1,CRHDE2,CRHDE3,CRHDE4
  1.  N CRHDX2,CRHDRSL,CRHDL,CRHDXCT,CRHDTRSL,CRHDEX,CRHDEE,CRHDXY
  1.  S Y=-1
  1.  S CRHDE1=+CRHDE                          ;internal entry number to file
  1.  S CRHDE2=$P(CRHDE,"^",2)                 ;name
  1.  S CRHDE3=$P(CRHDE,"^",3)                 ;types
  1.  ;                                         USR - New Person
  1.  ;                                         OTL - OE/RR Team
  1.  ;                                         SRV - Service/Section
  1.  ;                                         DIV-Institution;
  1.  ;
  1.  S CRHDCT=0
  1.  S CRHDL=$L(CRHDE,"^")
  1.  S CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)                  ;User Sign in Division
  1.  I $P(CRHDE4,"`",2)="" D USERDIV^CRHD5(.CRHDEE,DUZ) S CRHDE4="DIV.`"_$G(CRHDEE(1))
  1.  S CRHDE3=$P($P(CRHDE,"^",CRHDL),"-",1)
  1.  S CRHDPAR=CRHDE3_".`"_CRHDE1
  1.  I CRHDPAR'="" D LOOKUP^XPAREDIT(CRHDPAR,183)
  1.  I Y>-1 D
  1.  .S CRHDMN=+Y
  1.  .S CRHDP=0
  1.  .F  S CRHDP=$O(^CRHD(183,CRHDMN,1,CRHDP)) Q:'CRHDP  D
  1.  ..S CRHDCT=CRHDCT+1
  1.  ..I $P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",2)="" D
  1.  ...S CRHDX2=0 F  S CRHDX2=$O(^CRHD(183,CRHDMN,1,CRHDP,1,CRHDX2)) Q:'CRHDX2  D
  1.  ....S CRHDRTN(CRHDCT)=$P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,CRHDMN,1,CRHDP,1,CRHDX2,0))
  1.  ....S CRHDCT=CRHDCT+1
  1.  ..E  S CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,CRHDP,0))
  1.  ;get Temp fields expiration days
  1.  S CRHDEX=$$GET^XPAR(CRHDE4,"CRHD TEMP FLD EXPIRE",1,"I")
  1.  I 'CRHDEX S CRHDEX=2
  1.  S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)="TEMP_FLD_EXPIRE"_"^"_CRHDEX
  1.  ;get dnr title and/or text
  1.  K CRHDRSL D DNRPARM^CRHDDR(.CRHDRSL,DUZ,$P($P(CRHDE,"^",CRHDL),"-",2)) D
  1.  .I $D(CRHDRSL) D
  1.  ..S (CRHDXCT,CRHDXY)=0 F  S CRHDXY=$O(CRHDRSL(CRHDXY)) Q:'CRHDXY  D
  1.  ...S CRHDXCT=CRHDXCT+1,CRHDTRSL(CRHDXCT)=CRHDXY_"^"_$P($G(^ORD(101.43,+CRHDXY,0)),"^",1)
  1.  .I $D(CRHDTRSL) K CRHDRSL M CRHDRSL=CRHDTRSL K CRHDTRSL
  1.  I $D(CRHDRSL) D RTNLST("DNR_Titles") K CRHDRSL
  1.  D GET^CRHD5(.CRHDRSL,CRHDE4,"CRHD DNR ORDER TITLE")
  1.  I $D(CRHDRSL) D RTNLST("DNR_Text")
  1.  Q
  1. RTNLST(CRHDTT) ;
  1.  I $D(CRHDRSL) D
  1.  .S CRHDX=0
  1.  .I CRHDTT["DNR_Titles" F  S CRHDX=$O(CRHDRSL(CRHDX)) Q:'CRHDX  S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTT_"^"_CRHDRSL(CRHDX)
  1.  .E  F  S CRHDX=$O(CRHDRSL(CRHDX)) Q:'CRHDX  S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTT_"^"_$P(CRHDRSL(CRHDX),"^",2)
  1.  Q
  1.  ;
  1. SAVEP(CRHDRTN,CRHDE,CRHDPN,CRHDV,CRHDVAL) ;
  1.  N CRHDENT,CRHDX,CRHDX1,CRHDOLST,CRHDFG,CRHDL
  1.  S CRHDRTN(0)=1
  1.  I CRHDE="" S CRHDRTN(0)=0_"^Entity data not valid" Q
  1.  S CRHDL=$L(CRHDE,"^")
  1.  I +CRHDE S CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
  1.  I CRHDPN="" S CRHDPN="CRHD DNR ORDER TITLE"
  1.  ;get all Instances of a Parameter
  1.  D GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,"I")
  1.  I $D(CRHDOLST) S CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN)
  1.  I $D(CRHDVAL) D
  1.  .S CRHDX=0,CRHDCT=0
  1.  .F  S CRHDX=$O(CRHDVAL(CRHDX)) Q:'CRHDX  D
  1.  ..S CRHDCT=CRHDCT+1
  1.  ..D SET^CRHD5(CRHDENT,CRHDPN,CRHDCT,CRHDVAL(CRHDX))
  1.  Q
  1. SAVEP2(CRHDRTN,CRHDE,CRHDPN,CRHDV,CRHDVAL) ;
  1.  N CRHDENT,CRHDX,CRHDX1,CRHDOLST,CRHDFG,CRHDL
  1.  S CRHDRTN(0)=1
  1.  I CRHDE="" S CRHDRTN(0)=0_"^Entity data not valid" Q
  1.  S CRHDL=$L(CRHDE,"^")
  1.  I +CRHDE S CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
  1.  I CRHDPN="" S CRHDRTN(0)=0_"^Parameter name not valid" Q     ;S PN="CRHD DNR ORDER TITLE"
  1.  I CRHDV=""&('$D(CRHDVAL)) S CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN) S CRHDRTN(0)=1 Q
  1.  ;get all Instances of a Parameter
  1.  D GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,"I")
  1.  I $G(CRHDOLST) S CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN) K CRHDOLST
  1.  I $D(CRHDVAL) D
  1.  .S CRHDX=0,CRHDCT=0
  1.  .F  S CRHDX=$O(CRHDVAL(CRHDX)) Q:'CRHDX  D
  1.  ..S CRHDCT=CRHDCT+1
  1.  ..I CRHDVAL(CRHDX)'="" D
  1.  ...I CRHDVAL(CRHDX)?1N.E S CRHDVAL(CRHDX)=+CRHDVAL(CRHDX)
  1.  ...I CRHDVAL(CRHDX)?1A.E S CRHDVAL(CRHDX)=$P(CRHDVAL(CRHDX),"^",1)
  1.  ..D SET^CRHD5(CRHDENT,CRHDPN,CRHDCT,CRHDVAL(CRHDX))
  1.  Q
  1. GETPAR2(CRHDRTN,CRHDE,CRHDPN) ;
  1.  ;Get XPAR parameter values
  1.  N CRHDENT,CRHDX,CRHDX1,CRHDL,CRHDOLST,CRHDPNUM,CRHDFMT,CRHDFG
  1.  N CRHDI
  1.  S CRHDRTN(0)=1
  1.  S CRHDFMT="I"
  1.  I CRHDE="" S CRHDRTN(0)=0_"^Entity data not valid" Q
  1.  S CRHDL=$L(CRHDE,"^")
  1.  I +CRHDE S CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
  1.  I CRHDPN="" S CRHDRTN(0)=0_"^Parameter name not valid" Q     ;S PN="CRHD DNR ORDER TITLE"
  1.  ;get format code
  1.  S CRHDPNUM=$O(^XTV(8989.51,"B",CRHDPN,0))
  1.  I CRHDPNUM D
  1.  .S CRHDFMT=$S(($P($G(^XTV(8989.51,CRHDPNUM,1)),"^",1)="F")!($P($G(^XTV(8989.51,CRHDPNUM,1)),"^",6)="F"):"E",1:"B")
  1.  ;get all Instances of a Parameter
  1.  D GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,CRHDFMT)
  1.  I CRHDFMT="B" D
  1.  .K CRHDRTN
  1.  .S CRHDI=0
  1.  .F  S CRHDI=$O(CRHDOLST(CRHDI)) Q:'CRHDI  S:$G(CRHDOLST(CRHDI,"V"))'="" CRHDRTN(CRHDI)=$G(CRHDOLST(CRHDI,"V"))
  1.  E  K CRHDRTN D
  1.  .S CRHDI=0
  1.  .F  S CRHDI=$O(CRHDOLST(CRHDI)) Q:'CRHDI  S CRHDRTN(CRHDI)=$P(CRHDOLST(CRHDI),"^",2)
  1.  Q
  1. PARAM(VAL,APARAM) ; return a parameter value for a user
  1.  ; call assumes current user, default entities, single instance
  1.  S VAL=$$GET^XPAR("ALL",APARAM,1,"I")
  1.  Q