GECSPOST ;WISC/RFJ-version 2 post-init ;28 Jun 94
;;2.0;GCS;;MAR 14, 1995
N %,D,DA,DIK,X,Y
; clean out data in file 2101.4 (template maps) which are not
; used in version 2
S X=^GECS(2101.4,0) K ^GECS(2101.4) S ^GECS(2101.4,0)=$P(X,"^",1,2)
; clean out data in file 2101.6 (lock display)
S X=^GECS(2101.6,0) K ^GECS(2101.6) S ^GECS(2101.6,0)=$P(X,"^",1,2)
;
; remove 'gecs batch edit' input template which is no longer used
S DA=+$O(^DIE("F2100","GECS BATCH EDIT",0)) I DA S DIK="^DIE(" D ^DIK
;
; remove 2101.6, field 1 locked
I $D(^DD(2101.6,1)) S DIK="^DD(2101.6,",DA(1)=2101.6,DA=1 D ^DIK
;
; remove 2101.7, field 2 days to retain code sheets
S %=0 F S %=$O(^GECS(2101.7,%)) Q:'% I $D(^(%,0)) S $P(^(0),"^",3)=""
I $D(^DD(2101.7,2)) S DIK="^DD(2101.7,",DA(1)=2101.7,DA=2 D ^DIK
;
; remove 2100, field .7 batch type
I $D(^DD(2100,.7)) S DIK="^DD(2100,",DA(1)=2100,DA=.7 D ^DIK
;
; change yes/no for consistency
; file 2101.7, field 1 primary site
S %=0 F S %=$O(^GECS(2101.7,%)) Q:'% S D=$P($G(^(%,0)),"^",2) I D'="" S $P(^(0),"^",2)=$S(D=1:"Y",1:"N")
;
; repoint pointer fields for transported file entries
S GECSFIX=1 D GO^GECSVFY0
D PATCH^GECSPOS1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSPOST 1258 printed Nov 22, 2024@17:06:25 Page 2
GECSPOST ;WISC/RFJ-version 2 post-init ;28 Jun 94
+1 ;;2.0;GCS;;MAR 14, 1995
+2 NEW %,D,DA,DIK,X,Y
+3 ; clean out data in file 2101.4 (template maps) which are not
+4 ; used in version 2
+5 SET X=^GECS(2101.4,0)
KILL ^GECS(2101.4)
SET ^GECS(2101.4,0)=$PIECE(X,"^",1,2)
+6 ; clean out data in file 2101.6 (lock display)
+7 SET X=^GECS(2101.6,0)
KILL ^GECS(2101.6)
SET ^GECS(2101.6,0)=$PIECE(X,"^",1,2)
+8 ;
+9 ; remove 'gecs batch edit' input template which is no longer used
+10 SET DA=+$ORDER(^DIE("F2100","GECS BATCH EDIT",0))
IF DA
SET DIK="^DIE("
DO ^DIK
+11 ;
+12 ; remove 2101.6, field 1 locked
+13 IF $DATA(^DD(2101.6,1))
SET DIK="^DD(2101.6,"
SET DA(1)=2101.6
SET DA=1
DO ^DIK
+14 ;
+15 ; remove 2101.7, field 2 days to retain code sheets
+16 SET %=0
FOR
SET %=$ORDER(^GECS(2101.7,%))
if '%
QUIT
IF $DATA(^(%,0))
SET $PIECE(^(0),"^",3)=""
+17 IF $DATA(^DD(2101.7,2))
SET DIK="^DD(2101.7,"
SET DA(1)=2101.7
SET DA=2
DO ^DIK
+18 ;
+19 ; remove 2100, field .7 batch type
+20 IF $DATA(^DD(2100,.7))
SET DIK="^DD(2100,"
SET DA(1)=2100
SET DA=.7
DO ^DIK
+21 ;
+22 ; change yes/no for consistency
+23 ; file 2101.7, field 1 primary site
+24 SET %=0
FOR
SET %=$ORDER(^GECS(2101.7,%))
if '%
QUIT
SET D=$PIECE($GET(^(%,0)),"^",2)
IF D'=""
SET $PIECE(^(0),"^",2)=$SELECT(D=1:"Y",1:"N")
+25 ;
+26 ; repoint pointer fields for transported file entries
+27 SET GECSFIX=1
DO GO^GECSVFY0
+28 DO PATCH^GECSPOS1
+29 QUIT
