| 1 | PRC0B2 ;WISC/PLT-TASK/DEVICE/MM UTILITY ; 06/30/94 12:40 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ; invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;prca date ~1=[label]^routine, ~2=task description
|
|---|
| 7 | ;prcb data ~1=variable name/global root, ~2...
|
|---|
| 8 | ;prcc data ~1=1 if ask start time, ~2=start time (fm time/$h-time), ~3=keep until time (fm/$h)
|
|---|
| 9 | ; ~4=i/o device name, ~5=priority(1-10),
|
|---|
| 10 | ; ~6=task uci, ~7=volume set,
|
|---|
| 11 | TASK(PRCA,PRCB,PRCC) ;EF value ^1 task number, ^2=start time(fm/$h)
|
|---|
| 12 | ;task set-up
|
|---|
| 13 | N ZTRN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSK
|
|---|
| 14 | N A,B
|
|---|
| 15 | S ZTRTN=$P(PRCA,"~"),ZTDESC=$P(PRCA,"~",2)
|
|---|
| 16 | I $G(PRCB)]"" F A=1:1 Q:$P(PRCB,"~",A,999)="" S B=$P(PRCB,"~",A) S:B]"" @("ZTSAVE("""_B_""")=""""")
|
|---|
| 17 | S ZTIO=""
|
|---|
| 18 | S PRCC=$G(PRCC) S:'PRCC ZTDTH=$S($P(PRCC,"~",2)="":$H,1:$P(PRCC,"~",2))
|
|---|
| 19 | I $P(PRCC,"~",3,999)]"" D
|
|---|
| 20 | . S:$P(PRCC,"~",3)]"" ZTKILL=$P(PRCC,"~",3)
|
|---|
| 21 | . S:$P(PRCC,"~",4)]"" ZTIO=$P(PRCC,"~",4)
|
|---|
| 22 | . S:$P(PRCC,"~",5)]"" ZTPRI=$P(PRCC,"~",5)
|
|---|
| 23 | . S:$P(PRCC,"~",6)]"" ZTUCI=$P(PRCC,"~",6)
|
|---|
| 24 | . S:$P(PRCC,"~",7)]"" ZTCPU=$P(PRCC,"~",7)
|
|---|
| 25 | . QUIT
|
|---|
| 26 | D ^%ZTLOAD
|
|---|
| 27 | QUIT $G(ZTSK)_"^"_$G(ZTSK("D"))
|
|---|
| 28 | ;
|
|---|
| 29 | ;PRCA data ^1=message subject, ^2=message sender's name (option)
|
|---|
| 30 | ;xmtext text array name with left parenthesis
|
|---|
| 31 | ;.xmy recipients ri/name, group array
|
|---|
| 32 | ;.xmrou rourtine name array
|
|---|
| 33 | ;.xmstrip striped character array
|
|---|
| 34 | MM(PRCA,XMTEXT,XMY,XMROU,XMSTRIP) ;mail message sending
|
|---|
| 35 | N XMSUB,XMDUZ
|
|---|
| 36 | S XMSUB=$P(PRCA,"^") S:$P(PRCA,"^",2)]"" XMDUZ=$P(PRCA,"^",2)
|
|---|
| 37 | D ^XMD
|
|---|
| 38 | QUIT
|
|---|
| 39 | ;
|
|---|
| 40 | ;A=ri of file 3.8
|
|---|
| 41 | MG(A) ;EF value=mail group name in file 3.8
|
|---|
| 42 | D PIECE^PRC0B("3.8;;"_A,.01,"I","A")
|
|---|
| 43 | QUIT $G(A(3.8,A,.01,"I"))
|
|---|
| 44 | ;
|
|---|
| 45 | ;PRCA=package name (.01) in file 9.4
|
|---|
| 46 | PKGVER(PRCA) ;EF - ^1=ri of file 9.4, ^2=version number from node version if defined
|
|---|
| 47 | ; ^3=version number from node 22, ^4=version install date from node 22
|
|---|
| 48 | N A,B,C
|
|---|
| 49 | S (A,B)=""
|
|---|
| 50 | Q:$D(PRCPKVER(PRCA)) PRCPKVER(PRCA)
|
|---|
| 51 | S A=$O(^DIC(9.4,"B",PRCA,""))
|
|---|
| 52 | I A S PRCPKVER(PRCA)=A,$P(PRCPKVER(PRCA),"^",2)=$P($G(^DIC(9.4,A,"VERSION")),"^"),$P(PRCPKVER(PRCA),"^",3)=$P(PRCPKVER(PRCA),"^",2) D:$P(PRCPKVER(PRCA),"^",2)=""
|
|---|
| 53 | . D EN^DDIOL("Package is defined, but has not current version data.")
|
|---|
| 54 | . D EN^DDIOL("Please call IRM!")
|
|---|
| 55 | S:'A PRCPKVER(PRCA)=""
|
|---|
| 56 | QUIT PRCPKVER(PRCA)
|
|---|
| 57 | ;
|
|---|
| 58 | ;A=DATE/TIME, B='I' if fileman date, 'H' if $H DATE, 'E' if external date
|
|---|
| 59 | ;C="S" if second required
|
|---|
| 60 | DT(A,B,C) ;EF value: -1 if wrong format, ^1=fileman.time, ^$h date,time
|
|---|
| 61 | ; ^3-week day, ^4=mm/dd/yy@time, ^5=alpha date@time
|
|---|
| 62 | N %DT,X,Y,Z,%H,%,%T,%Y
|
|---|
| 63 | S:'$D(C) C="" S Z=""
|
|---|
| 64 | I B="E" D QUIT:Z=-1 Z
|
|---|
| 65 | . S %DT="FPT" S:C="S" %DT=%DT_"S"
|
|---|
| 66 | . S X=A D ^%DT S Z=Y
|
|---|
| 67 | I B="H" D
|
|---|
| 68 | . S %H=A D YMD^%DTC S Z=X,%=$P(A,",",2) D S^%DTC S Z=Z_%
|
|---|
| 69 | S:Z="" Z=A
|
|---|
| 70 | S X=Z D H^%DTC S $P(Z,"^",2)=%H_","_%T,$P(Z,"^",3)=%Y
|
|---|
| 71 | S Y=$P(Z,"^") S:C="S" %DT="S" D DD^%DT S $P(Z,"^",5)=Y,A=$P(Y,"@",2)
|
|---|
| 72 | S $P(Z,"^",4)=$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)
|
|---|
| 73 | S:$P(Z,"^")["." $P(Z,"^",4)=$P(Z,"^",4)_"@"_$TR(A,":","")
|
|---|
| 74 | QUIT Z
|
|---|
