- 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 Mar 13, 2025@21:00:56 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
