- PRC0B2 ;WISC/PLT-TASK/DEVICE/MM UTILITY ; 06/30/94 12:40 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ; invalid entry
- ;
- ;prca date ~1=[label]^routine, ~2=task description
- ;prcb data ~1=variable name/global root, ~2...
- ;prcc data ~1=1 if ask start time, ~2=start time (fm time/$h-time), ~3=keep until time (fm/$h)
- ; ~4=i/o device name, ~5=priority(1-10),
- ; ~6=task uci, ~7=volume set,
- TASK(PRCA,PRCB,PRCC) ;EF value ^1 task number, ^2=start time(fm/$h)
- ;task set-up
- N ZTRN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSK
- N A,B
- S ZTRTN=$P(PRCA,"~"),ZTDESC=$P(PRCA,"~",2)
- I $G(PRCB)]"" F A=1:1 Q:$P(PRCB,"~",A,999)="" S B=$P(PRCB,"~",A) S:B]"" @("ZTSAVE("""_B_""")=""""")
- S ZTIO=""
- S PRCC=$G(PRCC) S:'PRCC ZTDTH=$S($P(PRCC,"~",2)="":$H,1:$P(PRCC,"~",2))
- I $P(PRCC,"~",3,999)]"" D
- . S:$P(PRCC,"~",3)]"" ZTKILL=$P(PRCC,"~",3)
- . S:$P(PRCC,"~",4)]"" ZTIO=$P(PRCC,"~",4)
- . S:$P(PRCC,"~",5)]"" ZTPRI=$P(PRCC,"~",5)
- . S:$P(PRCC,"~",6)]"" ZTUCI=$P(PRCC,"~",6)
- . S:$P(PRCC,"~",7)]"" ZTCPU=$P(PRCC,"~",7)
- . QUIT
- D ^%ZTLOAD
- QUIT $G(ZTSK)_"^"_$G(ZTSK("D"))
- ;
- ;PRCA data ^1=message subject, ^2=message sender's name (option)
- ;xmtext text array name with left parenthesis
- ;.xmy recipients ri/name, group array
- ;.xmrou rourtine name array
- ;.xmstrip striped character array
- MM(PRCA,XMTEXT,XMY,XMROU,XMSTRIP) ;mail message sending
- N XMSUB,XMDUZ
- S XMSUB=$P(PRCA,"^") S:$P(PRCA,"^",2)]"" XMDUZ=$P(PRCA,"^",2)
- D ^XMD
- QUIT
- ;
- ;A=ri of file 3.8
- MG(A) ;EF value=mail group name in file 3.8
- D PIECE^PRC0B("3.8;;"_A,.01,"I","A")
- QUIT $G(A(3.8,A,.01,"I"))
- ;
- ;PRCA=package name (.01) in file 9.4
- PKGVER(PRCA) ;EF - ^1=ri of file 9.4, ^2=version number from node version if defined
- ; ^3=version number from node 22, ^4=version install date from node 22
- N A,B,C
- S (A,B)=""
- Q:$D(PRCPKVER(PRCA)) PRCPKVER(PRCA)
- S A=$O(^DIC(9.4,"B",PRCA,""))
- 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)=""
- . D EN^DDIOL("Package is defined, but has not current version data.")
- . D EN^DDIOL("Please call IRM!")
- S:'A PRCPKVER(PRCA)=""
- QUIT PRCPKVER(PRCA)
- ;
- ;A=DATE/TIME, B='I' if fileman date, 'H' if $H DATE, 'E' if external date
- ;C="S" if second required
- DT(A,B,C) ;EF value: -1 if wrong format, ^1=fileman.time, ^$h date,time
- ; ^3-week day, ^4=mm/dd/yy@time, ^5=alpha date@time
- N %DT,X,Y,Z,%H,%,%T,%Y
- S:'$D(C) C="" S Z=""
- I B="E" D QUIT:Z=-1 Z
- . S %DT="FPT" S:C="S" %DT=%DT_"S"
- . S X=A D ^%DT S Z=Y
- I B="H" D
- . S %H=A D YMD^%DTC S Z=X,%=$P(A,",",2) D S^%DTC S Z=Z_%
- S:Z="" Z=A
- S X=Z D H^%DTC S $P(Z,"^",2)=%H_","_%T,$P(Z,"^",3)=%Y
- S Y=$P(Z,"^") S:C="S" %DT="S" D DD^%DT S $P(Z,"^",5)=Y,A=$P(Y,"@",2)
- S $P(Z,"^",4)=$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)
- S:$P(Z,"^")["." $P(Z,"^",4)=$P(Z,"^",4)_"@"_$TR(A,":","")
- QUIT Z
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC0B2 3020 printed Feb 18, 2025@23:25:38 Page 2
- PRC0B2 ;WISC/PLT-TASK/DEVICE/MM UTILITY ; 06/30/94 12:40 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ; invalid entry
- QUIT
- +3 ;
- +4 ;prca date ~1=[label]^routine, ~2=task description
- +5 ;prcb data ~1=variable name/global root, ~2...
- +6 ;prcc data ~1=1 if ask start time, ~2=start time (fm time/$h-time), ~3=keep until time (fm/$h)
- +7 ; ~4=i/o device name, ~5=priority(1-10),
- +8 ; ~6=task uci, ~7=volume set,
- TASK(PRCA,PRCB,PRCC) ;EF value ^1 task number, ^2=start time(fm/$h)
- +1 ;task set-up
- +2 NEW ZTRN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSK
- +3 NEW A,B
- +4 SET ZTRTN=$PIECE(PRCA,"~")
- SET ZTDESC=$PIECE(PRCA,"~",2)
- +5 IF $GET(PRCB)]""
- FOR A=1:1
- if $PIECE(PRCB,"~",A,999)=""
- QUIT
- SET B=$PIECE(PRCB,"~",A)
- if B]""
- SET @("ZTSAVE("""_B_""")=""""")
- +6 SET ZTIO=""
- +7 SET PRCC=$GET(PRCC)
- if 'PRCC
- SET ZTDTH=$SELECT($PIECE(PRCC,"~",2)="":$HOROLOG,1:$PIECE(PRCC,"~",2))
- +8 IF $PIECE(PRCC,"~",3,999)]""
- Begin DoDot:1
- +9 if $PIECE(PRCC,"~",3)]""
- SET ZTKILL=$PIECE(PRCC,"~",3)
- +10 if $PIECE(PRCC,"~",4)]""
- SET ZTIO=$PIECE(PRCC,"~",4)
- +11 if $PIECE(PRCC,"~",5)]""
- SET ZTPRI=$PIECE(PRCC,"~",5)
- +12 if $PIECE(PRCC,"~",6)]""
- SET ZTUCI=$PIECE(PRCC,"~",6)
- +13 if $PIECE(PRCC,"~",7)]""
- SET ZTCPU=$PIECE(PRCC,"~",7)
- +14 QUIT
- End DoDot:1
- +15 DO ^%ZTLOAD
- +16 QUIT $GET(ZTSK)_"^"_$GET(ZTSK("D"))
- +17 ;
- +18 ;PRCA data ^1=message subject, ^2=message sender's name (option)
- +19 ;xmtext text array name with left parenthesis
- +20 ;.xmy recipients ri/name, group array
- +21 ;.xmrou rourtine name array
- +22 ;.xmstrip striped character array
- MM(PRCA,XMTEXT,XMY,XMROU,XMSTRIP) ;mail message sending
- +1 NEW XMSUB,XMDUZ
- +2 SET XMSUB=$PIECE(PRCA,"^")
- if $PIECE(PRCA,"^",2)]""
- SET XMDUZ=$PIECE(PRCA,"^",2)
- +3 DO ^XMD
- +4 QUIT
- +5 ;
- +6 ;A=ri of file 3.8
- MG(A) ;EF value=mail group name in file 3.8
- +1 DO PIECE^PRC0B("3.8;;"_A,.01,"I","A")
- +2 QUIT $GET(A(3.8,A,.01,"I"))
- +3 ;
- +4 ;PRCA=package name (.01) in file 9.4
- PKGVER(PRCA) ;EF - ^1=ri of file 9.4, ^2=version number from node version if defined
- +1 ; ^3=version number from node 22, ^4=version install date from node 22
- +2 NEW A,B,C
- +3 SET (A,B)=""
- +4 if $DATA(PRCPKVER(PRCA))
- QUIT PRCPKVER(PRCA)
- +5 SET A=$ORDER(^DIC(9.4,"B",PRCA,""))
- +6 IF A
- SET PRCPKVER(PRCA)=A
- SET $PIECE(PRCPKVER(PRCA),"^",2)=$PIECE($GET(^DIC(9.4,A,"VERSION")),"^")
- SET $PIECE(PRCPKVER(PRCA),"^",3)=$PIECE(PRCPKVER(PRCA),"^",2)
- if $PIECE(PRCPKVER(PRCA),"^",2)=""
- Begin DoDot:1
- +7 DO EN^DDIOL("Package is defined, but has not current version data.")
- +8 DO EN^DDIOL("Please call IRM!")
- End DoDot:1
- +9 if 'A
- SET PRCPKVER(PRCA)=""
- +10 QUIT PRCPKVER(PRCA)
- +11 ;
- +12 ;A=DATE/TIME, B='I' if fileman date, 'H' if $H DATE, 'E' if external date
- +13 ;C="S" if second required
- DT(A,B,C) ;EF value: -1 if wrong format, ^1=fileman.time, ^$h date,time
- +1 ; ^3-week day, ^4=mm/dd/yy@time, ^5=alpha date@time
- +2 NEW %DT,X,Y,Z,%H,%,%T,%Y
- +3 if '$DATA(C)
- SET C=""
- SET Z=""
- +4 IF B="E"
- Begin DoDot:1
- +5 SET %DT="FPT"
- if C="S"
- SET %DT=%DT_"S"
- +6 SET X=A
- DO ^%DT
- SET Z=Y
- End DoDot:1
- if Z=-1
- QUIT Z
- +7 IF B="H"
- Begin DoDot:1
- +8 SET %H=A
- DO YMD^%DTC
- SET Z=X
- SET %=$PIECE(A,",",2)
- DO S^%DTC
- SET Z=Z_%
- End DoDot:1
- +9 if Z=""
- SET Z=A
- +10 SET X=Z
- DO H^%DTC
- SET $PIECE(Z,"^",2)=%H_","_%T
- SET $PIECE(Z,"^",3)=%Y
- +11 SET Y=$PIECE(Z,"^")
- if C="S"
- SET %DT="S"
- DO DD^%DT
- SET $PIECE(Z,"^",5)=Y
- SET A=$PIECE(Y,"@",2)
- +12 SET $PIECE(Z,"^",4)=$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Z,2,3)
- +13 if $PIECE(Z,"^")["."
- SET $PIECE(Z,"^",4)=$PIECE(Z,"^",4)_"@"_$TRANSLATE(A,":","")
- +14 QUIT Z