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

PSUTL.m

Go to the documentation of this file.
  1. PSUTL ;BIR/PDW - Utilities for AR/WS extracts ;12 AUG 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ; Reference to DOLRO^%ZOSV supported by DBIA 2500
  1. ;
  1. ; Entry Points
  1. ;
  1. ; D GETS^PSUTL(,,,,)
  1. ; D GETM^PSUTL(,,,,)
  1. ; $$VAL^PSUTL(,,)
  1. ; $$VALI^PSUTL(,,)
  1. ; ---------------------
  1. ; D MOVEI^PSUTL("ref") Moves @ref@(Fld,"I") Value to (Fld) node
  1. ; D MOVEMI^PSUTL("ref") Moves @ref@(da,Fld,"I") value to (da,Fld) node
  1. ; ---------------------
  1. ; ---------------------
  1. ; Details & Parameters
  1. ; D GETS^PSUTL(,,,,) Returns @root@(Field Number(s)) = Value(s)
  1. ; Multiples NO
  1. ;
  1. ; D GETM^PSUTL(,,,,) Returns @root@(DA,Field Number(s)) = Value(s)
  1. ; Multiples YES & ONLY
  1. ;
  1. ; S X=$$VAL^PSUTL(,,) X = External Value
  1. ; S X=$$VALI^PSUTL(,,) X = Interanl Value
  1. ;
  1. ; [ Variables for Parameter Passing ]
  1. ; PSUFILE = file number or subfile number as described in GETS^DIQ()
  1. ; PSUDA = List or array of IENS NOT as described in GETS^DIQ()
  1. ;
  1. ; A .DA array or a list of IENS left to right as they are in the
  1. ; global data arrays D0,D1,D2 as within a FM Global map
  1. ; This Iens list can be constructed with variables.
  1. ; Example: as reaching into file 200 division subfile 200.02
  1. ; "DUZ,SITE"
  1. ;
  1. ; PSUDR = DR string as described in GETS^DIQ()
  1. ; PSUROOT = closed array as described in GETS^DIQ()
  1. ; PSUFORM = format control as described in GETS^DIQ()
  1. ;
  1. GETS(PSUFILE,PSUDA,PSUDR,PSUROOT,PSUFORM) ;
  1. ; Example S PSUSITE=6025
  1. ; D GETS^PSUTL(200.02,"DUZ,PSUSITE",".01","DIV")
  1. ; returns
  1. ; DIV(.01)="HINES DEVELOPMENT"
  1. ;
  1. N PSUIEN,DA
  1. I $D(PSUFILE),$D(PSUDA),$D(PSUDR),$D(PSUROOT)
  1. E Q
  1. I '$D(PSUFORM) S PSUFORM=""
  1. D PARSE(PSUDA)
  1. S PSUIEN=$$IENS^DILF(.DA)
  1. K ^TMP("PSUDIQ",$J)
  1. D GETS^DIQ(PSUFILE,PSUIEN,PSUDR,PSUFORM,"^TMP(""PSUDIQ"",$J)")
  1. ;
  1. I $G(PSUMTUL) Q
  1. ;
  1. M @PSUROOT=^TMP("PSUDIQ",$J,PSUFILE,PSUIEN)
  1. K ^TMP("PSUDIQ",$J)
  1. Q
  1. ;
  1. VAL(PSUFILE,PSUDA,PSUFLD) ; Returns External Value
  1. N PSUTMP
  1. I $D(PSUFILE),$D(PSUDA),$D(PSUFLD)
  1. E Q ""
  1. D GETS(PSUFILE,PSUDA,PSUFLD,"PSUTMP")
  1. Q $G(PSUTMP(PSUFLD))
  1. VALI(PSUFILE,PSUDA,PSUFLD) ; Returns Internal Value
  1. N PSUTMP
  1. I $D(PSUFILE),$D(PSUDA),$D(PSUFLD)
  1. E Q ""
  1. D GETS(PSUFILE,PSUDA,PSUFLD,"PSUTMP","I")
  1. Q $G(PSUTMP(PSUFLD,"I"))
  1. ;
  1. GETM(PSUFILE,PSUDA,PSUFLD,PSUROOT,PSUFORM) ;EP RETURN MULTIPLES
  1. ; PSUFILE is the immediate upper level file number of the one desired
  1. ; PSUDA is the "DO,D1,Dx .." IENS to get to the immediate upper level
  1. ; PSUFLD is the field notation for the multiple at the upper level
  1. ; "3*"
  1. ; appended with "^" and the list of fields ".01;.02;9.3;..."
  1. ; resulting in "3*^.01;.02;9.3;..."
  1. ; PSUROOT is the target closed array reference
  1. ; PSUFORM is the format as in GET^DIQ
  1. ; return form is @PSUROOT@(da,fld)=VALUE
  1. ;
  1. ; example: pulls multiple divisions from file 200
  1. ; D GETM^PSUTL(200,DUZ,"16*^.01","DIV")
  1. ; Returns DIV(578,.01) ="HINES, IL"
  1. ; DIV(6020,.01)="HINES ISC"
  1. ; DIV(6025,.01)="HINES DEVELOPMENT"
  1. ;
  1. N PSUMTUL,PSUSUB,PSUDID
  1. I $D(PSUFILE),$D(PSUDA),$D(PSUFLD),$D(PSUROOT)
  1. E Q
  1. S PSUMTUL=1
  1. I '$D(PSUFORM) S PSUFORM=""
  1. I PSUFLD'["^" Q
  1. K PSUFLDL
  1. S PSUFLDL=$P(PSUFLD,U,2),PSUFLD=$P(PSUFLD,U)
  1. I +PSUFLDL,+PSUFLD
  1. E Q
  1. D FIELD^DID(PSUFILE,+PSUFLD,"","SPECIFIER","PSUDID")
  1. S PSUSUB=+PSUDID("SPECIFIER")
  1. D GETS(PSUFILE,PSUDA,PSUFLD,PSUROOT,PSUFORM)
  1. ; load multiple into target array
  1. S PSUIEN=0 F S PSUIEN=$O(^TMP("PSUDIQ",$J,PSUSUB,PSUIEN)) Q:+PSUIEN'>0 M @PSUROOT@(+PSUIEN)=^TMP("PSUDIQ",$J,PSUSUB,PSUIEN)
  1. K ^TMP("PSUDIQ",$J)
  1. Q:'$D(PSUFLDL)
  1. ;
  1. ; process individual fields
  1. N I,FLD
  1. S FLD=+PSUFLDL,PSUFLDL(FLD)=0
  1. F I=2:1 S FLD=$P(PSUFLDL,";",I) Q:FLD'>0 S PSUFLDL(FLD)=""
  1. S PSUIEN=0 F S PSUIEN=$O(@PSUROOT@(PSUIEN)) Q:PSUIEN'>0 D
  1. . S FLD=0
  1. . F S FLD=$O(@PSUROOT@(PSUIEN,FLD)) Q:FLD'>0 I '$D(PSUFLDL(FLD)) K @PSUROOT@(PSUIEN,FLD)
  1. K PSUFLDL
  1. Q
  1. PARSE(XBDA) ;PEP - parse DA literal into da array
  1. I XBDA="",$D(XBDA)=1 S DA=0 Q
  1. NEW D,I,J
  1. F I=1:1 S D(I)=$P(XBDA,",",I) Q:D(I)=""
  1. S I=I-1
  1. F J=0:1:I-1 S DA(J)=D(I-J)
  1. F J=0:1:I-1 F Q:(DA(J)=+DA(J)) S DA(J)=@(DA(J)) S:DA(J)="" DA(J)=0
  1. S DA=DA(0)
  1. KILL DA(0)
  1. Q
  1. MOVEI(PSUREF) ;EP Move @PSUREF@(Fld,"I") values to @PSUREF@(Fld)
  1. N PSUFLD
  1. S PSUFLD=0 F S PSUFLD=$O(@PSUREF@(PSUFLD)) Q:PSUFLD'>0 S @PSUREF@(PSUFLD)=$G(@PSUREF@(PSUFLD,"I")) K @PSUREF@(PSUFLD,"I")
  1. Q
  1. ;
  1. MOVEMI(PSUREF) ;EP Move @PSUREF@(da,Fld,"I") values to @PSUREF@(da,Fld)
  1. N PSUDA,PSUFLD
  1. S PSUDA=0 F S PSUDA=$O(@PSUREF@(PSUDA)) Q:PSUDA'>0 D
  1. . S PSUFLD=0 F S PSUFLD=$O(@PSUREF@(PSUDA,PSUFLD)) Q:PSUFLD'>0 S @PSUREF@(PSUDA,PSUFLD)=@PSUREF@(PSUDA,PSUFLD,"I") K @PSUREF@(PSUDA,PSUFLD,"I")
  1. Q
  1. ;
  1. UPPER(PSUX) ;Convert lower case to upper case
  1. Q $TR(PSUX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. ;
  1. VARKILL ;PEP Kill variable PSU* namespace
  1. ;Kills off all PSU Variables
  1. S X="^TMP(""PSUVAR"",$J,"
  1. D DOLRO^%ZOSV ; load symbols into ^TMP(,,var)=..
  1. ; (preserve PSU,PSUXMY*)
  1. S X="" F S X=$O(^TMP("PSUVAR",$J,X)) Q:X="" I $E(X,1,3)="PSU",X'="PSU",($E(X,1,6)'="PSUXMY"),X'="PSUJOB" K @X
  1. K ^TMP("PSUVAR",$J)
  1. ;
  1. ;