SCMCGU ;ALB/JLU;General PCMM utilities;7/1/99 ; 3/29/00 12:34pm
;;5.3;Scheduling;**195,177,212**;AUG 13, 1993
;
NEWPERSN(IEN,ARY) ;This function takes an internal value/DUZ of the
;person you wish info on and performs a silent FM call to retrieve
;the data. DBIA #10060
;
;INPUTS
; IEN - the internal entry number of the user you want in
; VA(200. (REQUIRED)
; ARY - the closed array reference the data is to be returned in.
; This must be a clean array. This API will not issue any
; kills with this structure.(OPTIONAL)
; If no array is entered ^TMP("PCMM_PERSON",$J,IEN) will be used.
;
;OUTPUTS
; ARY(IEN)=Piece Structure below
; 1 - User Name (EXTERNAL)
; 2 - Office Phone number
; 3 - Room
; 4 - Service/Section (EXTERNAL)
; 5 - Voice Pager number
; 6 - Social Security number
;
;If successful 1 is return as the results of the function.
;If not successfull 0^reason is returned.
;
N STOP
S STOP=0
D PARCHK G:STOP MNQ
D GETDATA
MNQ Q $S(STOP=0:1,1:0_U_$P(STOP,U,2))
;
PARCHK ;Checks the parameters that are passed in.
;
I '+$G(IEN) S STOP="1^Bad pointer value to file 200"
I $G(ARY)']"" S ARY="^TMP(""PCMM_PERSON"",$J)"
Q
;
GETDATA ;Make the FM calls and formats the return array.
;
N BLDERR
K ^TMP("SCMC_BLD_PERSON",$J)
D GETS^DIQ(200,IEN,".01;.132;.137;.141;29;9","EI","^TMP(""SCMC_BLD_PERSON"","_$J_")","BLDERR")
;only reporting the first one
I $D(BLDERR) S STOP=1_U_BLDERR("DIERR",1,"TEXT",1) Q
S $P(@ARY@(IEN),U,1)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",.01,"E")
S $P(@ARY@(IEN),U,2)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",.132,"E")
S $P(@ARY@(IEN),U,3)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",.141,"E")
S $P(@ARY@(IEN),U,4)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",29,"E")
S $P(@ARY@(IEN),U,5)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",.137,"E")
S $P(@ARY@(IEN),U,6)=^TMP("SCMC_BLD_PERSON",$J,200,IEN_",",9,"E")
K ^TMP("SCMC_BLD_PERSON",$J)
Q
;
PDAT(SCPATCH,SCERROR) ;
; alb/rpm Patch 212
; This function is used to retrieve the PATCH install date when
; passed the PATCH name. The PATCH install date is found in the
; subfile #9.4901 field #.02.
;
; DBIA:#10048 indicates that Package(#9.4) file is open for read
; only with FM.
;
; Input:
; SCPATCH - Patch designation (i.e. SD*5.3*177)
; SCERROR (optional) - Variable stores user named variable
; to return error text. Passing ""
; is treated the same as no parameter.
;
; Output:
; Function value - Date patch installed on success, otherwise 0
; on failure.
; SCERROR - Variable stores error text explaining function
; failure. Only output if user passes second
; parameter to function and an error occurs.
;
; Validate input
I $L(SCPATCH,"*")'=3 D Q 0
. S:$G(SCERROR)]"" @SCERROR="Invalid input parameter"
; Verify patch is loaded
I '$$PATCH^XPDUTL(SCPATCH) D Q 0
. S:$G(SCERROR)]"" @SCERROR="Patch "_SCPATCH_" not loaded"
; Initialize locals
NEW SCDATE,SCFILE,SCI,SCERR,SCIEN,SCPAT
; Search for Patch designation in #9.4 and subfiles (#9.49, #9.4901)
S SCIEN=""
F SCI=1:1:3 D Q:$D(SCERR)!'SCIEN(SCI)
. S SCFILE=$S(SCI=1:9.4,SCI=2:9.49,1:9.4901)
. S SCPAT=$P(SCPATCH,"*",SCI)
. S SCIEN(SCI)=$$FIND1^DIC(SCFILE,SCIEN,"MX",SCPAT,"","","SCERR")
. ; Check for alternate form of patch name (i.e. "176 SEQ #158")
. I SCI=3,'SCIEN(SCI) S SCPAT=SCPAT_" SEQ" D
. . S SCIEN(SCI)=$$FIND1^DIC(SCFILE,SCIEN,"M",SCPAT,"","","SCERR")
. Q:$D(SCERR)!'SCIEN(SCI)
. S SCIEN=$S(SCI<3:",",1:"")_SCIEN(SCI)_$S(SCI=1:",",1:"")_SCIEN
; Check for search errors
I 'SCIEN(SCI) S:$G(SCERROR)]"" @SCERROR="Search failed" Q 0
I $D(SCERR) S:$G(SCERROR)]"" @SCERROR=$G(SCERR("DIERR",1,"TEXT",1)) Q 0
;
; Retrieve date
S SCDATE=$$GET1^DIQ(SCFILE,SCIEN,.02,"I","","SCERR")
I $D(SCERR) S:$G(SCERROR)]"" @SCERROR=$G(SCERR("DIERR",1,"TEXT",1)) Q 0
;
D CLEAN^DILF
Q SCDATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCGU 4101 printed Sep 23, 2025@20:16:40 Page 2
SCMCGU ;ALB/JLU;General PCMM utilities;7/1/99 ; 3/29/00 12:34pm
+1 ;;5.3;Scheduling;**195,177,212**;AUG 13, 1993
+2 ;
NEWPERSN(IEN,ARY) ;This function takes an internal value/DUZ of the
+1 ;person you wish info on and performs a silent FM call to retrieve
+2 ;the data. DBIA #10060
+3 ;
+4 ;INPUTS
+5 ; IEN - the internal entry number of the user you want in
+6 ; VA(200. (REQUIRED)
+7 ; ARY - the closed array reference the data is to be returned in.
+8 ; This must be a clean array. This API will not issue any
+9 ; kills with this structure.(OPTIONAL)
+10 ; If no array is entered ^TMP("PCMM_PERSON",$J,IEN) will be used.
+11 ;
+12 ;OUTPUTS
+13 ; ARY(IEN)=Piece Structure below
+14 ; 1 - User Name (EXTERNAL)
+15 ; 2 - Office Phone number
+16 ; 3 - Room
+17 ; 4 - Service/Section (EXTERNAL)
+18 ; 5 - Voice Pager number
+19 ; 6 - Social Security number
+20 ;
+21 ;If successful 1 is return as the results of the function.
+22 ;If not successfull 0^reason is returned.
+23 ;
+24 NEW STOP
+25 SET STOP=0
+26 DO PARCHK
if STOP
GOTO MNQ
+27 DO GETDATA
MNQ QUIT $SELECT(STOP=0:1,1:0_U_$PIECE(STOP,U,2))
+1 ;
PARCHK ;Checks the parameters that are passed in.
+1 ;
+2 IF '+$GET(IEN)
SET STOP="1^Bad pointer value to file 200"
+3 IF $GET(ARY)']""
SET ARY="^TMP(""PCMM_PERSON"",$J)"
+4 QUIT
+5 ;
GETDATA ;Make the FM calls and formats the return array.
+1 ;
+2 NEW BLDERR
+3 KILL ^TMP("SCMC_BLD_PERSON",$JOB)
+4 DO GETS^DIQ(200,IEN,".01;.132;.137;.141;29;9","EI","^TMP(""SCMC_BLD_PERSON"","_$JOB_")","BLDERR")
+5 ;only reporting the first one
+6 IF $DATA(BLDERR)
SET STOP=1_U_BLDERR("DIERR",1,"TEXT",1)
QUIT
+7 SET $PIECE(@ARY@(IEN),U,1)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",.01,"E")
+8 SET $PIECE(@ARY@(IEN),U,2)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",.132,"E")
+9 SET $PIECE(@ARY@(IEN),U,3)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",.141,"E")
+10 SET $PIECE(@ARY@(IEN),U,4)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",29,"E")
+11 SET $PIECE(@ARY@(IEN),U,5)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",.137,"E")
+12 SET $PIECE(@ARY@(IEN),U,6)=^TMP("SCMC_BLD_PERSON",$JOB,200,IEN_",",9,"E")
+13 KILL ^TMP("SCMC_BLD_PERSON",$JOB)
+14 QUIT
+15 ;
PDAT(SCPATCH,SCERROR) ;
+1 ; alb/rpm Patch 212
+2 ; This function is used to retrieve the PATCH install date when
+3 ; passed the PATCH name. The PATCH install date is found in the
+4 ; subfile #9.4901 field #.02.
+5 ;
+6 ; DBIA:#10048 indicates that Package(#9.4) file is open for read
+7 ; only with FM.
+8 ;
+9 ; Input:
+10 ; SCPATCH - Patch designation (i.e. SD*5.3*177)
+11 ; SCERROR (optional) - Variable stores user named variable
+12 ; to return error text. Passing ""
+13 ; is treated the same as no parameter.
+14 ;
+15 ; Output:
+16 ; Function value - Date patch installed on success, otherwise 0
+17 ; on failure.
+18 ; SCERROR - Variable stores error text explaining function
+19 ; failure. Only output if user passes second
+20 ; parameter to function and an error occurs.
+21 ;
+22 ; Validate input
+23 IF $LENGTH(SCPATCH,"*")'=3
Begin DoDot:1
+24 if $GET(SCERROR)]""
SET @SCERROR="Invalid input parameter"
End DoDot:1
QUIT 0
+25 ; Verify patch is loaded
+26 IF '$$PATCH^XPDUTL(SCPATCH)
Begin DoDot:1
+27 if $GET(SCERROR)]""
SET @SCERROR="Patch "_SCPATCH_" not loaded"
End DoDot:1
QUIT 0
+28 ; Initialize locals
+29 NEW SCDATE,SCFILE,SCI,SCERR,SCIEN,SCPAT
+30 ; Search for Patch designation in #9.4 and subfiles (#9.49, #9.4901)
+31 SET SCIEN=""
+32 FOR SCI=1:1:3
Begin DoDot:1
+33 SET SCFILE=$SELECT(SCI=1:9.4,SCI=2:9.49,1:9.4901)
+34 SET SCPAT=$PIECE(SCPATCH,"*",SCI)
+35 SET SCIEN(SCI)=$$FIND1^DIC(SCFILE,SCIEN,"MX",SCPAT,"","","SCERR")
+36 ; Check for alternate form of patch name (i.e. "176 SEQ #158")
+37 IF SCI=3
IF 'SCIEN(SCI)
SET SCPAT=SCPAT_" SEQ"
Begin DoDot:2
+38 SET SCIEN(SCI)=$$FIND1^DIC(SCFILE,SCIEN,"M",SCPAT,"","","SCERR")
End DoDot:2
+39 if $DATA(SCERR)!'SCIEN(SCI)
QUIT
+40 SET SCIEN=$SELECT(SCI<3:",",1:"")_SCIEN(SCI)_$SELECT(SCI=1:",",1:"")_SCIEN
End DoDot:1
if $DATA(SCERR)!'SCIEN(SCI)
QUIT
+41 ; Check for search errors
+42 IF 'SCIEN(SCI)
if $GET(SCERROR)]""
SET @SCERROR="Search failed"
QUIT 0
+43 IF $DATA(SCERR)
if $GET(SCERROR)]""
SET @SCERROR=$GET(SCERR("DIERR",1,"TEXT",1))
QUIT 0
+44 ;
+45 ; Retrieve date
+46 SET SCDATE=$$GET1^DIQ(SCFILE,SCIEN,.02,"I","","SCERR")
+47 IF $DATA(SCERR)
if $GET(SCERROR)]""
SET @SCERROR=$GET(SCERR("DIERR",1,"TEXT",1))
QUIT 0
+48 ;
+49 DO CLEAN^DILF
+50 QUIT SCDATE
