SC53P581 ;ALB/ESW - Patch Install Routine ; 3/29/12 11:20am
;;5.3;SCHEDULING;**581**;Aug 13, 1993;Build 16
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ; File # 404.52 print template compilation routine
N SCTEM,SCTEMP
M SCTEMP=^DIPT("AF",404.52,.03) ; all fields have the same templates so .03 is used
S SCTEM=""
F S SCTEM=$O(SCTEMP(SCTEM)) Q:SCTEM="" D
.N DMAX,X,Y,SCROUT
.S SCROUT=$G(^DIPT(SCTEM,"ROU")) ;Routine name
.S X=SCROUT,$E(X)="" ; Remove initial ^.
.S Y=SCTEM
.S DMAX=$$ROUSIZE^DILF
.D EN^DIPZ
D MES^XPDUTL(" Done.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSC53P581 602 printed Dec 13, 2024@02:37:40 Page 2
SC53P581 ;ALB/ESW - Patch Install Routine ; 3/29/12 11:20am
+1 ;;5.3;SCHEDULING;**581**;Aug 13, 1993;Build 16
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ; File # 404.52 print template compilation routine
+1 NEW SCTEM,SCTEMP
+2 ; all fields have the same templates so .03 is used
MERGE SCTEMP=^DIPT("AF",404.52,.03)
+3 SET SCTEM=""
+4 FOR
SET SCTEM=$ORDER(SCTEMP(SCTEM))
if SCTEM=""
QUIT
Begin DoDot:1
+5 NEW DMAX,X,Y,SCROUT
+6 ;Routine name
SET SCROUT=$GET(^DIPT(SCTEM,"ROU"))
+7 ; Remove initial ^.
SET X=SCROUT
SET $EXTRACT(X)=""
+8 SET Y=SCTEM
+9 SET DMAX=$$ROUSIZE^DILF
+10 DO EN^DIPZ
End DoDot:1
+11 DO MES^XPDUTL(" Done.")
+12 QUIT
+13 ;
