SC53P581.m

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 ---SC53P581   602     printed  Apr 09, 2024@21:49:49                                                                                                                                                                                                     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      ;