DG53231P ;ISA/Zoltan - Post-install for DG*5.3*231;April 7, 1999
;;5.3;Registration;**231**;Aug 13, 1993
;
POST ; Re-compiles print and input templates for those fields
; included in the patch.
N FLDLIST,FLD,PTEMP,ETEMP,TEMPLATE,ROUTINE,MAXSIZE,X,Y,DMAX
D LOADFLDS(.FLDLIST) ; Obtain list of fields being sent.
S FLD="" ; For each field...
F S FLD=$O(FLDLIST(FLD)) Q:FLD="" D
. M PTEMP=^DIPT("AF",2,FLD) ; ...note affected print templates...
. M ETEMP=^DIE("AF",2,FLD) ; ...note affected edit templates.
; Determine maximum routine size...
S MAXSIZE=$$ROUSIZE^DILF
; Recompile print templates...
D BMES^XPDUTL(" *****************************")
D BMES^XPDUTL(" * Compiling Print Templates *")
D BMES^XPDUTL(" *****************************")
S TEMPLATE=""
F S TEMPLATE=$O(PTEMP(TEMPLATE)) Q:TEMPLATE="" D
. S ROUTINE=$G(^DIPT(TEMPLATE,"ROU")) ; Note Routine Name
. I ROUTINE="" Q ; Not a compiled template.
. ; Set up bulletproof FileMan call.
. S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
. S $E(X)="" ; Remove initial ^.
. ; This NEW only lasts for one loop iteration...
. N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
. D EN^DIPZ ; Classic FileMan--Trust No One.
; Recompile edit templates...
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" *****************************")
D BMES^XPDUTL(" * Compiling Input Templates *")
D BMES^XPDUTL(" *****************************")
S TEMPLATE=""
F S TEMPLATE=$O(ETEMP(TEMPLATE)) Q:TEMPLATE="" D
. S ROUTINE=$G(^DIE(TEMPLATE,"ROU")) ; Note Routine Name
. I ROUTINE="" Q
. ; Set up bulletproof FileMan call.
. S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
. S $E(X)="" ; Remove initial ^.
. ; This NEW only lasts for one loop iteration...
. N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
. D EN^DIEZ ; Classic FileMan--Trust No One.
Q
LOADFLDS(ARR) ; Load field list.
N FNUM,FNAME,LINE,TEXT
F TEXT=1:1 S LINE=$T(FLDS+TEXT) Q:$P(LINE," ")'="" D
. S FNUM=$P(LINE,";",3)
. S FNAME=$P(LINE,";",4)
. S ARR(FNUM)=FNAME
Q
FLDS ; Fields included in this patch.
;;.02;SEX
;;.03;DATE OF BIRTH
;;.05;MARITAL STATUS
;;.08;RELIGIOUS PREFERENCE
;;.09;SOCIAL SECURITY NUMBER
;;.111;STREET ADDRESS [LINE 1]
;;.1112;ZIP+4
;;.112;STREET ADDRESS [LINE 2]
;;.113;STREET ADDRESS [LINE 3]
;;.114;CITY
;;.115;STATE
;;.117;COUNTY
;;.131;PHONE NUMBER [RESIDENCE]
;;.132;PHONE NUMBER [WORK]
;;.211;K-NAME OF PRIMARY NOK
;;.219;K-PHONE NUMBER
;;.2403;MOTHER'S MAIDEN NAME
;;.301;SERVICE CONNECTED?
;;.302;SERVICE CONNECTED PERCENTAGE
;;.31115;EMPLOYMENT STATUS
;;.323;PERIOD OF SERVICE
;;.351;DATE OF DEATH
;;391;TYPE
;;1901;VETERAN
END ;End of field list.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53231P 2677 printed Dec 13, 2024@02:36:46 Page 2
DG53231P ;ISA/Zoltan - Post-install for DG*5.3*231;April 7, 1999
+1 ;;5.3;Registration;**231**;Aug 13, 1993
+2 ;
POST ; Re-compiles print and input templates for those fields
+1 ; included in the patch.
+2 NEW FLDLIST,FLD,PTEMP,ETEMP,TEMPLATE,ROUTINE,MAXSIZE,X,Y,DMAX
+3 ; Obtain list of fields being sent.
DO LOADFLDS(.FLDLIST)
+4 ; For each field...
SET FLD=""
+5 FOR
SET FLD=$ORDER(FLDLIST(FLD))
if FLD=""
QUIT
Begin DoDot:1
+6 ; ...note affected print templates...
MERGE PTEMP=^DIPT("AF",2,FLD)
+7 ; ...note affected edit templates.
MERGE ETEMP=^DIE("AF",2,FLD)
End DoDot:1
+8 ; Determine maximum routine size...
+9 SET MAXSIZE=$$ROUSIZE^DILF
+10 ; Recompile print templates...
+11 DO BMES^XPDUTL(" *****************************")
+12 DO BMES^XPDUTL(" * Compiling Print Templates *")
+13 DO BMES^XPDUTL(" *****************************")
+14 SET TEMPLATE=""
+15 FOR
SET TEMPLATE=$ORDER(PTEMP(TEMPLATE))
if TEMPLATE=""
QUIT
Begin DoDot:1
+16 ; Note Routine Name
SET ROUTINE=$GET(^DIPT(TEMPLATE,"ROU"))
+17 ; Not a compiled template.
IF ROUTINE=""
QUIT
+18 ; Set up bulletproof FileMan call.
+19 SET X=ROUTINE
SET Y=TEMPLATE
SET DMAX=MAXSIZE
+20 ; Remove initial ^.
SET $EXTRACT(X)=""
+21 ; This NEW only lasts for one loop iteration...
+22 NEW ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
+23 ; Classic FileMan--Trust No One.
DO EN^DIPZ
End DoDot:1
+24 ; Recompile edit templates...
+25 DO BMES^XPDUTL(" ")
+26 DO BMES^XPDUTL(" *****************************")
+27 DO BMES^XPDUTL(" * Compiling Input Templates *")
+28 DO BMES^XPDUTL(" *****************************")
+29 SET TEMPLATE=""
+30 FOR
SET TEMPLATE=$ORDER(ETEMP(TEMPLATE))
if TEMPLATE=""
QUIT
Begin DoDot:1
+31 ; Note Routine Name
SET ROUTINE=$GET(^DIE(TEMPLATE,"ROU"))
+32 IF ROUTINE=""
QUIT
+33 ; Set up bulletproof FileMan call.
+34 SET X=ROUTINE
SET Y=TEMPLATE
SET DMAX=MAXSIZE
+35 ; Remove initial ^.
SET $EXTRACT(X)=""
+36 ; This NEW only lasts for one loop iteration...
+37 NEW ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
+38 ; Classic FileMan--Trust No One.
DO EN^DIEZ
End DoDot:1
+39 QUIT
LOADFLDS(ARR) ; Load field list.
+1 NEW FNUM,FNAME,LINE,TEXT
+2 FOR TEXT=1:1
SET LINE=$TEXT(FLDS+TEXT)
if $PIECE(LINE," ")'=""
QUIT
Begin DoDot:1
+3 SET FNUM=$PIECE(LINE,";",3)
+4 SET FNAME=$PIECE(LINE,";",4)
+5 SET ARR(FNUM)=FNAME
End DoDot:1
+6 QUIT
FLDS ; Fields included in this patch.
+1 ;;.02;SEX
+2 ;;.03;DATE OF BIRTH
+3 ;;.05;MARITAL STATUS
+4 ;;.08;RELIGIOUS PREFERENCE
+5 ;;.09;SOCIAL SECURITY NUMBER
+6 ;;.111;STREET ADDRESS [LINE 1]
+7 ;;.1112;ZIP+4
+8 ;;.112;STREET ADDRESS [LINE 2]
+9 ;;.113;STREET ADDRESS [LINE 3]
+10 ;;.114;CITY
+11 ;;.115;STATE
+12 ;;.117;COUNTY
+13 ;;.131;PHONE NUMBER [RESIDENCE]
+14 ;;.132;PHONE NUMBER [WORK]
+15 ;;.211;K-NAME OF PRIMARY NOK
+16 ;;.219;K-PHONE NUMBER
+17 ;;.2403;MOTHER'S MAIDEN NAME
+18 ;;.301;SERVICE CONNECTED?
+19 ;;.302;SERVICE CONNECTED PERCENTAGE
+20 ;;.31115;EMPLOYMENT STATUS
+21 ;;.323;PERIOD OF SERVICE
+22 ;;.351;DATE OF DEATH
+23 ;;391;TYPE
+24 ;;1901;VETERAN
END ;End of field list.
